SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00019 1 08-24-9413:32ALL FRANK DIACHEYSN DOS Flush function SWAG9408 aⁿΓ@ 10 ┤φ {π Coded By Frank Diacheysn Of Gemini Softwareππ FUNCTION DOSFLUSHππ Input......: F = Variable File (Text Or File) To "Flush"π :π :π :π :ππ Output.....: Logicalπ : TRUE = Successfully Flushed Buffersπ : FALSE = Flush Failedπ :π :ππ Example....: IF DOSFLUSH( TextFile ) THENπ : WriteLn('DOS Buffers For TEMP.TXT Flushed To Disk.')π : ELSEπ : WriteLn('DOS Error While Trying To Flush Buffers For TEMP.TXT');π :ππ Description: Flushes DOS Buffers For A Fileπ :π :π :π :ππ}πFUNCTION DOSFLUSH( VAR F ):BOOLEAN; ASSEMBLER;πASMπ MOV AX, 3000Hπ INT 21Hπ CMP AL, 3π JL @Oldπ CMP AH, 1EHπ LES DI, Fπ MOV BX, ES:[DI]π MOV AH, 68Hπ INT 21Hπ JC @BadEndπ JMP @GoodEndππ @Old:π LES DI, Fπ MOV BX, ES:[DI]π MOV AH, 45Hπ INT 21Hπ JC @BadEndπ @Ok:π MOV BX, AXπ MOV AH, 3EHπ INT 21Hπ JC @BadEndπ @GoodEnd:π MOV AX, 0π @BadEnd:πEND;π 2 08-24-9413:34ALL ANDREW EIGUS Enhanced DOS Interface SWAG9408 nyµ 408 ┤φ {πI'm very glad to be useful and to post the enhanced DOS unit for Turbo Pascalπ7.0. It includes lots of nice routines written on inline asm, combined withπshort comments and explanations. All you have in standard DOS unit you mayπfind in EnhDOS as well except of Exec and SwapVectors. Sure, the full sourceπcode!ππWhat is good?π-----------------ππ1. Fast! (because of the asm)π2. Flexible! (less procedures, more functions, lots of parameters)π3. Good error-handling routines. (don't need to care to check errors at all)π4. _Strong_ file service. (lots of file functions)π5. Lots of additional DOS service functions that can't be found in any standardπ or non-standard Pascal, C,... library.π6. Windows (tm) compatible (means you may use these routines when developingπ Windows (tm) applications.π7. Own memory allocate/release routines. (used DOS memory allocation)π8. Free. Released to a Public Domain.ππWhat is bad?π-----------------ππ1. Requires Borland Turbo Pascal version 7.0 or later (7.01)π2. Requires DOS 3.1 or later. Sorry guys, wanna cool service - need later DOS.π3. Won't run on XT personal computers. (uses 286 instructions)π4. No more strings. (all string-type names are of PChar type)π5. Exec and SwapVectors not implemented. If you'd like this code, I willπ continue modifying this unit and will eventually add the above functionsπ too.ππWell, routines were checked on IBM PS/2 386SX, seems like work fine!ππGreetingz toπ-----------------ππ Bas van Gaalen (cool asm programmer and my PASCAL area friend ;)π Dj Murdoch (best explainer ;)π Gayle Davis (SWAG live forever) Feel free to place it into a next SWAG bundle.π Ralph Brown (brilliant idea to make the interrupt list)π Alex Grischenko (whose asm help was very appreciated)π ...and all of you, guys!ππMaterial usedπ-----------------ππBorland Pascal 7.0 Runtime Library source codeπRalph Brown's Interrupt ListπTech Help 4.0πππYou may use this source-code-software in ANY purpose. Code may be changed.πIf some of the routines won't work, please send me a message.πIf you don't mind, please leave my copyright strings as they are.}ππUnit EnhDOS;π(*π Turbo Pascal 7.0 - ENHDOS.PASππ Enhanced DOS interface unit for DOS 3.1+ *** Version 1.1 April, 1994.π Copyright (c) 1994 by Andrew Eigus Fidonet 2:5100/33ππ Runtime Library Portions Copyright (c) 1991,92 Borland International }ππ THIS UNIT SOURCE IS FREEπ*)ππinterfaceππ{$X+} { Enable extended syntax }π{$G+} { Enable 286+ instructions }ππconstππ { My copyright information }ππ Copyright : PChar = 'Portions Copyright (c) 1994 by Andrew Eigus';ππ { GetDriveType return values }ππ dtError = $00; { Bad drive }π dtFixed = $01; { Fixed drive }π dtRemovable = $02; { Removable drive }π dtRemote = $03; { Remote (network) drive }ππ { Handle file open modes (om) constants }ππ omRead = $00; { Open file for input only }π omWrite = $01; { Open file for output only }π omReadWrite = $02; { Open file for input or/and output (both modes) }π omShareCompat = $00; { Modes used when SHARE.EXE loaded }π omShareExclusive = $10;π omShareDenyWrite = $20;π omShareDenyRead = $30;π omShareDenyNone = $40;ππ { Maximum file name component string lengths }ππ fsPathName = 79;π fsDirectory = 67;π fsFileSpec = 12;π fsFileName = 8;π fsExtension = 4;ππ { FileSplit return flags }ππ fcExtension = $0001;π fcFileName = $0002;π fcDirectory = $0004;π fcWildcards = $0008;ππ { File attributes (fa) constants }ππ faNormal = $00;π faReadOnly = $01;π faHidden = $02;π faSysFile = $04;π faVolumeID = $08;π faDirectory = $10;π faArchive = $20;π faAnyFile = $3F;ππ { Seek start offset (sk) constants }ππ skStart = 0; { Seek position relative to the beginning of a file }π skPos = 1; { Seek position relative to a current file position }π skEnd = 2; { Seek position relative to the end of a file }ππ { Error handler function (fr) result codes }ππ frOk = 0; { Continue program }π frRetry = 1; { Retry function once again }ππ { Function codes (only passed to error handler routine) (fn) constants }ππ fnGetDPB = $3200;π fnGetDiskSize = $3600;π fnGetDiskFree = $3601;π fnGetCountryInfo = $3800;π fnSetDate = $2B00;π fnSetTime = $2D00;π fnIsFixedDisk = $4408;π fnIsNetworkDrive = $4409;π fnCreateDir = $3900;π fnRemoveDir = $3A00;π fnGetCurDir = $4700;π fnSetCurDir = $3B00;π fnDeleteFile = $4100;π fnRenameFile = $5600;π fnGetFileAttr = $4300;π fnSetFileAttr = $4301;π fnFindFirst = $4E00;π fnFindNext = $4F00;π fnCreateFile = $5B00;π fnCreateTempFile = $5A00;π fnOpenFile = $3D00;π fnRead = $3F00;π fnWrite = $4000;π fnSeek = $4200;π fnGetFDateTime = $5700;π fnSetFDateTime = $5701;π fnCloseFile = $3E00;π fnMemAlloc = $4800;π fnMemFree = $4900;ππ { DOS 3.x+ errors/return codes }ππ dosrOk = 0; { Success }π dosrInvalidFuncNumber = 1; { Invalid DOS function number }π dosrFileNotFound = 2; { File not found }π dosrPathNotFound = 3; { Path not found }π dosrTooManyOpenFiles = 4; { Too many open files }π dosrFileAccessDenied = 5; { File access denied }π dosrInvalidFileHandle = 6; { Invalid file handle }π dosrNotEnoughMemory = 8; { Not enough memory }π dosrInvalidEnvment = 10; { Invalid environment }π dosrInvalidFormat = 11; { Invalid format }π dosrInvalidAccessCode = 12; { Invalid file access code }π dosrInvalidDrive = 15; { Invalid drive number }π dosrCantRemoveDir = 16; { Cannot remove current directory }π dosrCantRenameDrives = 17; { Cannot rename across drives }π dosrNoMoreFiles = 18; { No more files }ππtypeππ TPathStr = array[0..fsPathName] of Char;π TDirStr = array[0..fsDirectory] of Char;π TNameStr = array[0..fsFileName] of Char;π TExtStr = array[0..fsExtension] of Char;π TFileStr = array[0..fsFileSpec] of Char;ππ { Disk information block structure }ππ PDiskParamBlock = ^TDiskParamBlock;π TDiskParamBlock = recordπ Drive : byte; { Disk drive number (0=A, 1=B, 2=C...) }π SubunitNum : byte; { Sub-unit number from driver device header }π SectSize : word; { Number of bytes per sector }π SectPerClust : byte; { Number of sectors per cluster -1π (max sector in cluster) }π ClustToSectShft : byte; { Cluster-to-sector shift }π BootSize : word; { Reserved sectors (boot secs; start of root dir}π FATCount : byte; { Number of FATs }π MaxDir : word; { Number of directory entries allowed in root }π DataSect : word; { Sector number of first data cluster }π Clusters : word; { Total number of allocation units (clusters)π +2 (number of highest cluster) }π FATSectors : byte; { Sectors needed by first FAT }π RootSect : word; { Sector number of start of root directory }π DeviceHeader : pointer; { Address of device header }π Media : byte; { Media descriptor byte }π AccessFlag : byte; { 0 if drive has been accessed }π NextPDB : pointer { Address of next DPB (0FFFFh if last) }π end;ππ { Disk allocation data structure }ππ PDiskAllocInfo = ^TDiskAllocInfo;π TDiskAllocInfo = recordπ FATId : byte; { FAT Id }π Clusters : word; { Number of allocation units (clusters) }π SectPerClust : byte; { Number of sectors per cluster }π SectSize : word { Number of bytes per sector }π end;ππ { Country information structure }ππ PCountryInfo = ^TCountryInfo;π TCountryInfo = recordπ DateFormat : word; { Date format value may be one of the following:π 0 - Month, Day, Year (USA)π 1 - Day, Month, Year (Europe)π 2 - Year, Month, Day (Japan) }ππ CurrencySymbol : array[0..4] of Char; { Currency symbol string }π ThousandsChar : byte; { Thousands separator character }π reserved1 : byte;π DecimalChar : byte; { Decimal separator character }π reserved2 : byte;π DateChar : byte; { Date separator character }π reserved3 : byte;π TimeChar : byte; { Time separator character }π reserved4 : byte;π CurrencyFormat : byte; { Currency format:π $XXX.XXπ XXX.XX$π $ XXX.XXπ XXX.XX $π XXX$XX }ππ Digits : byte; { Number of digits after decimal in currency }π TimeFormat : byte; { Time format may be one of the following:π bit 0 = 0 if 12 hour clockπ 1 if 24 hour clock }ππ MapRoutine : pointer; { Address of case map routine FAR CALL,π AL - character to map to upper case [>=80h] }ππ DataListChar : byte; { Data-list separator character }π reserved5 : byte;π reserved6 : array[1..10] of Charπ end;ππ THandle = Word; { Handle type (file handle and memory handle functions) }ππ { Error handler function }ππ TErrorFunc = function(ErrCode : integer; FuncCode : word) : byte;ππ { Search record used by FindFirst and FindNext }ππ TSearchRec = recordπ Fill : array[1..21] of Byte;π Attr : byte;π Time : longint;π Size : longint;π Name : TFileStrπ end;ππ { Date and time record used by PackTime and UnpackTime }ππ TDateTime = recordπ Year,π Month,π Day,π Hour,π Min,π Sec : wordπ end;πππvarπ DOSResult : integer; { Error status variable }π TempStr : array[0..High(String)] of Char;ππfunction SetErrorHandler(Handler : TErrorFunc) : pointer;πfunction Pas2PChar(S : string) : PChar;ππfunction GetInDOSFlag : boolean;πfunction GetDOSVersion : word;πfunction GetSwitchChar : char;πfunction SetSwitchChar(Switch : char) : byte;πfunction GetCountryInfo(var Info : TCountryInfo) : integer;πprocedure GetDate(var Year : word; var Month, Day, DayOfWeek : byte);πfunction SetDate(Year : word; Month, Day : byte) : boolean;πprocedure GetTime(var Hour, Minute, Second, Sec100 : byte);πfunction SetTime(Hour, Minute, Second, Sec100 : byte) : boolean;πfunction GetCBreak : boolean;πfunction SetCBreak(Break : boolean) : boolean;πfunction GetVerify : boolean;πfunction SetVerify(Verify : boolean) : boolean;πfunction GetArgCount : integer;πfunction GetArgStr(Dest : PChar; Index : integer; MaxLen : word) : PChar;πfunction GetEnvVar(VarName : PChar) : PChar;πfunction GetIntVec(IntNo : byte; var Vector : pointer) : pointer;πfunction SetIntVec(IntNo : byte; Vector : pointer) : pointer;ππfunction GetDTA : pointer;πfunction GetCurDisk : byte;πfunction SetCurDisk(Drive : byte) : byte;πprocedure GetDriveAllocInfo(Drive : byte; var Info : TDiskAllocInfo);πfunction GetDPB(Drive : byte; var DPB : TDiskParamBlock) : integer;πfunction DiskSize(Drive : byte) : longint;πfunction DiskFree(Drive : byte) : longint;πfunction IsFixedDisk(Drive : byte) : boolean;πfunction IsNetworkDrive(Drive : byte) : boolean;πfunction GetDriveType(Drive : byte) : byte;ππfunction CreateDir(Dir : PChar) : integer;πfunction RemoveDir(Dir : PChar) : integer;πfunction GetCurDir(Drive : byte; Dir : PChar) : integer;πfunction SetCurDir(Dir : PChar) : integer;ππfunction DeleteFile(Path : PChar) : integer;πfunction RenameFile(OldPath, NewPath : PChar) : integer;πfunction ExistsFile(Path : PChar) : boolean;πfunction GetFileAttr(Path : PChar) : integer;πfunction SetFileAttr(Path : PChar; Attr : word) : integer;πfunction FindFirst(Path : PChar; Attr: word; var F : TSearchRec) : integer;πfunction FindNext(var F : TSearchRec) : integer;πprocedure UnpackTime(P : longint; var T : TDateTime);πfunction PackTime(var T : TDateTime) : longint;ππfunction h_CreateFile(Path : PChar) : THandle;πfunction h_CreateTempFile(Path : PChar) : THandle;πfunction h_OpenFile(Path : PChar; Mode : byte) : THandle;πfunction h_Read(Handle : THandle; var Buffer; Count : word) : word;πfunction h_Write(Handle : THandle; var Buffer; Count : word) : word;πfunction h_Seek(Handle : THandle; SeekPos : longint; Start : byte) : longint;πfunction h_FilePos(Handle : THandle) : longint;πfunction h_FileSize(Handle : THandle) : longint;πfunction h_Eof(Handle : THandle) : boolean;πfunction h_GetFTime(Handle : THandle) : longint;πfunction h_SetFTime(Handle : THandle; DateTime : longint) : longint;πfunction h_CloseFile(Handle : THandle) : integer;ππfunction MemAlloc(Size : longint) : pointer;πfunction MemFree(P : pointer) : integer;ππfunction FileSearch(Dest, Name, List : PChar) : PChar;πfunction FileExpand(Dest, Name : PChar) : PChar;πfunction FileSplit(Path, Dir, Name, Ext : PChar) : word;ππimplementationππ{$IFDEF Windows}π{$DEFINE ProtectedMode}π{$ENDIF}ππ{$IFDEF DPMI}π{$DEFINE ProtectedMode}π{$ENDIF}ππ{$IFDEF Windows}ππuses WinTypes, WinProcs, Strings;ππ{$ELSE}ππuses Strings;ππ{$ENDIF}ππconst DOS = $21; { DOS interrupt number }ππvarπ ErrorHandler : TErrorFunc;ππFunction SetErrorHandler;π{ Sets the new error handler to hook all errors returned by EnhDOS functions,π and returns the pointer to an old interrupt handler routine }πBeginπ SetErrorHandler := @ErrorHandler;π ErrorHandler := HandlerπEnd; { SetErrorHandler }ππFunction Pas2PChar(S : string) : PChar;π{ Returns PChar type equivalent of the S variable. Use this functionπ to convert strings to PChars }πBeginπ Pas2PChar := StrPCopy(TempStr, S)πEnd; { Pas2PChar }ππ{$IFDEF Windows}ππprocedure AnsiDosFunc; assembler;πasmπ PUSH DSπ PUSH CXπ PUSH AXπ MOV SI,DIπ PUSH ESπ POP DSπ LEA DI,TempStrπ PUSH SSπ POP ESπ MOV CX,fsPathNameπ CLDπ@@1:π LODSBπ OR AL,ALπ JE @@2π STOSBπ LOOP @@1π@@2:π XOR AL,ALπ STOSBπ LEA DI,TempStrπ PUSH SSπ PUSH DIπ PUSH SSπ PUSH DIπ CALL AnsiToOemπ POP AXπ POP CXπ LEA DX,TempStrπ PUSH SSπ POP DSπ INT DOSπ POP DSπend; { AnsiDosFunc /Windows }ππ{$ELSE}ππprocedure AnsiDosFunc; assembler;πasmπ PUSH DSπ MOV DX,DIπ PUSH ESπ POP DSπ INT DOSπ POP DSπend; { AnsiDosFunc }ππ{$ENDIF}ππFunction GetInDOSFlag; assembler;π{ GETINDOSFLAG - DOS service functionπ Description: Returns the current state of InDOS flag; fn=34hπ Returns: True if a DOS operation is being performed, False if there isπ no DOS command that currently is running }πAsmπ MOV AH,34hπ INT DOSπ MOV AL,BYTE PTR [ES:BX]πEnd; { GetInDOSFlag }ππFunction GetDOSVersion; assembler;π{ GETDOSVERSION - DOS service functionπ Description: Retrieves DOS version number; fn=30hπ Returns: Major DOS version number in low-order byte,π minor version number in high-order byte of word }πAsmπ MOV AH,30hπ INT DOSπEnd; { GetDOSVersion }ππFunction GetSwitchChar; assembler;π{ GETSWITCHCHAR - DOS service functionπ Description: Retrieves DOS command line default switch character; fn=37hπ Returns: Switch character ('/', '-', ...) or FFh if unsupported subfunction }πAsmπ MOV AH,37hπ XOR AL,ALπ INT DOSπ CMP AL,0FFhπ JE @@1π MOV AL,DLπ@@1:πEnd; { GetSwitchChar }ππFunction SetSwitchChar; assembler;π{ SETSWITCHCHAR - DOS service functionπ Description: Sets new DOS command line switch character; fn=37hπ Returns: FFh if unsupported subfunction, any other value success }πAsmπ MOV AX,3701hπ MOV DL,Switchπ INT DOSπEnd; { SetSwitchChar }ππFunction GetCountryInfo; assembler;π{ GETCOUNTRYINFO - DOS service functionπ Description: Retrieves country information; fn=38hπ Returns: Country code if successful, negative DOS error code otherwise }πAsmπ@@1:π PUSH DSπ MOV AH,38hπ XOR AL,ALπ LDS DX,Infoπ INT DOSπ POP DSπ JC @@2π MOV AX,BXπ MOV DOSResult,dosrOkπ JMP @@3π@@2:π MOV DOSResult,AX { save error code in global variable }π PUSH AX { store error code }π PUSH fnGetCountryInfo { store function code }π CALL ErrorHandlerπ CMP AL,frRetryπ JE @@1π POP AXπ NEG AXπ@@3:πEnd; { GetCountryInfo }ππProcedure GetDate; assembler;π{ GETDATE - DOS service functionπ Description: Retrieves the current date set in the operating system.π Ranges of the values returned are: Year 1980-2099,π Month 1-12, Day 1-31 and DayOfWeek 0-6 (0 corresponds toπ Sunday) }πAsmπ MOV AH,2AHπ INT DOSπ XOR AH,AHπ LES DI,DayOfWeekπ STOSBπ MOV AL,DLπ LES DI,Dayπ STOSBπ MOV AL,DHπ LES DI,Monthπ STOSBπ XCHG AX,CXπ LES DI,Yearπ STOSWπEnd; { GetDate }ππFunction SetDate; assembler;π{ SETDATE - DOS service functionπ Description: Sets the current date in the operating system. Validπ parameter ranges are: Year 1980-2099, Month 1-12 andπ Day 1-31π Returns: True if the date was set, False if the date is not valid }πAsmπ MOV CX,Yearπ MOV DH,Monthπ MOV DL,Dayπ MOV AH,2BHπ INT DOSπ CMP AL,0π JE @@1π MOV DOSResult,AXπ PUSH AXπ PUSH fnSetDateπ CALL ErrorHandlerπ MOV AL,Trueπ@@1:π NOT ALπEnd; { SetDate }ππProcedure GetTime; assembler;π{ GETTIME - DOS service functionπ Description: Returns the current time set in the operating system.π Ranges of the values returned are: Hour 0-23, Minute 0-59,π Second 0-59 and Sec100 (hundredths of seconds) 0-99 }πAsmπ MOV AH,2CHπ INT DOSπ XOR AH,AHπ MOV AL,DLπ LES DI,Sec100π STOSBπ MOV AL,DHπ LES DI,Secondπ STOSBπ MOV AL,CLπ LES DI,Minuteπ STOSBπ MOV AL,CHπ LES DI,Hourπ STOSBπEnd; { GetTime }ππFunction SetTime; assembler;π{ SETTIME - DOS service functionπ Description: Sets the time in the operating system. Validπ parameter ranges are: Hour 0-23, Minute 0-59, Second 0-59 andπ Sec100 (hundredths of seconds) 0-99π Returns: True if the time was set, False if the time is not valid }πAsmπ MOV CH,Hourπ MOV CL,Minuteπ MOV DH,Secondπ MOV DL,Sec100π MOV AH,2DHπ INT DOSπ CMP AL,0π JE @@1π MOV DOSResult,AXπ PUSH AXπ PUSH fnSetTimeπ CALL ErrorHandlerπ MOV AL,Trueπ@@1:π NOT ALπEnd; { SetTime }ππFunction GetCBreak; assembler;π{ GETCBREAK - DOS service functionπ Description: Retrieves Control-Break state; fn=3300hπ Returns: Current Ctrl-Break state }πAsmπ MOV AX,3300hπ INT DOSπ MOV AL,DLπEnd; { GetCBreak }ππFunction SetCBreak; assembler;π{ SETCBREAK - DOS service functionπ Description: Sets new Control-Break state; fn=3300hπ Returns: Old Ctrl-Break state }πAsmπ CALL GetCBreakπ PUSH AXπ MOV AX,3301hπ MOV DL,Breakπ INT DOSπ POP AXπEnd; { SetCBreak }ππFunction GetVerify; assembler;π{ GETVERIFY - DOS service functionπ Description: Returns the state of the verify flag in DOS.π When off (False), disk writes are not verified.π When on (True), all disk writes are verified to insure properπ writing; fn=54hπ Returns: State of the verify flag }πAsmπ MOV AH,54Hπ INT DOSπEnd; { GetVerify }ππFunction SetVerify; assembler;π{ SETVERIFY - DOS service functionπ Description: Sets the state of the verify flag in DOS; fn=2Ehπ Returns: Previous state of the verify flag }πAsmπ CALL GetVerifyπ PUSH AXπ MOV AL,Verifyπ MOV AH,2EHπ INT DOSπ POP AXπEnd; { SetVerify }ππ{$IFDEF Windows}ππProcedure ArgStrCount; assembler;πAsmπ LDS SI,CmdLineπ CLDπ@@1:π LODSBπ OR AL,ALπ JE @@2π CMP AL,' 'π JBE @@1π@@2:π DEC SIπ MOV BX,SIπ@@3:π LODSBπ CMP AL,' 'π JA @@3π DEC SIπ MOV AX,SIπ SUB AX,BXπ JE @@4π LOOP @@1π@@4:πEnd; { ArgStrCount /Windows }ππFunction GetArgCount; assembler;π{ GETARGCOUNT - DOS service functionπ Description: Returns the number of parameters passed to theπ program on the command lineπ Returns: Actual number of command line parameters }ππAsmπ PUSH DSπ XOR CX,CXπ CALL ArgStrCountπ XCHG AX,CXπ NEG AXπ POP DSπEnd; { GetArgCount /Windows }ππFunction GetArgStr; assembler;π{ GETARGSTR - DOS service functionπ Description: Returns the specified parameter from the command lineπ Returns: ASCIIZ parameter, or an empty string if Index is less than zeroπ or greater than GetArgCount. If Index is zero, GetArgStr returnsπ the filename of the current module. The maximum length of theπ string returned in Dest is given by the MaxLen parameter. Theπ returned value is Dest }ππAsmπ MOV CX,Indexπ JCXZ @@2π PUSH DSπ CALL ArgStrCountπ MOV SI,BXπ LES DI,Destπ MOV CX,MaxLenπ CMP CX,AXπ JB @@1π XCHG AX,CXπ@@1:π REP MOVSBπ XCHG AX,CXπ STOSBπ POP DSπ JMP @@3π@@2:π PUSH HInstanceπ PUSH WORD PTR [Dest+2]π PUSH WORD PTR [Dest]π MOV AX,MaxLenπ INC AXπ PUSH AXπ CALL GetModuleFileNameπ@@3:π MOV AX,WORD PTR [Dest]π MOV DX,WORD PTR [Dest+2]πEnd; { GetArgStr /Windows }ππ{$ELSE}ππProcedure ArgStrCount; assembler;πAsmπ MOV DS,PrefixSegπ MOV SI,80Hπ CLDπ LODSBπ MOV DL,ALπ XOR DH,DHπ ADD DX,SIπ@@1:π CMP SI,DXπ JE @@2π LODSBπ CMP AL,' 'π JBE @@1π DEC SIπ@@2:π MOV BX,SIπ@@3:π CMP SI,DXπ JE @@4π LODSBπ CMP AL,' 'π JA @@3π DEC SIπ@@4:π MOV AX,SIπ SUB AX,BXπ JE @@5π LOOP @@1π@@5:πEnd; { ArgStrCount }ππFunction GetArgCount; assembler;π{ GETARGCOUNT - DOS service functionπ Description: Returns the number of parameters passed to theπ program on the command lineπ Returns: Actual number of command line parameters }πAsmπ PUSH DSπ XOR CX,CXπ CALL ArgStrCountπ XCHG AX,CXπ NEG AXπ POP DSπEnd; { GetArgCount }ππFunction GetArgStr; assembler;π{ GETARGSTR - DOS service functionπ Description: Returns the specified parameter from the command lineπ Returns: ASCIIZ parameter, or an empty string if Index is less than zeroπ or greater than GetArgCount. If Index is zero, GetArgStr returnsπ the filename of the current module. The maximum length of theπ string returned in Dest is given by the MaxLen parameter. Theπ returned value is Dest }πAsmπ PUSH DSπ MOV CX,Indexπ JCXZ @@1π CALL ArgStrCountπ MOV SI,BXπ JMP @@4π@@1:π MOV AH,30Hπ INT DOSπ CMP AL,3π MOV AX,0π JB @@4π MOV DS,PrefixSegπ MOV ES,DS:WORD PTR 2CHπ XOR DI,DIπ CLDπ@@2:π CMP AL,ES:[DI]π JE @@3π MOV CX,-1π REPNE SCASBπ JMP @@2π@@3:π ADD DI,3π MOV SI,DIπ PUSH ESπ POP DSπ MOV CX,256π REPNE SCASBπ XCHG AX,CXπ NOT ALπ@@4:π LES DI,Destπ MOV CX,MaxLenπ CMP CX,AXπ JB @@5π XCHG AX,CXπ@@5:π REP MOVSBπ XCHG AX,CXπ STOSBπ MOV AX,WORD PTR [Dest]π MOV DX,WORD PTR [Dest+2]π POP DSπEnd; { GetArgStr }ππ{$ENDIF}ππFunction GetEnvVar;π{ GETENVVAR - DOS service functionπ Description: Retrieves a specified DOS environment variableπ Returns: A pointer to the value of a specified variable,π i.e. a pointer to the first character after the equalsπ sign (=) in the environment entry given by VarName.π VarName is case insensitive. GetEnvVar returns NIL ifπ the specified environment variable does not exist }πvarπ L : word;π P : PChar;πBeginπ L := StrLen(VarName);π{$IFDEF Windows}π P := GetDosEnvironment;π{$ELSE}π P := Ptr(Word(Ptr(PrefixSeg, $2C)^), 0);π{$ENDIF}π while P^ <> #0 doπ beginπ if (StrLIComp(P, VarName, L) = 0) and (P[L] = '=') thenπ beginπ GetEnvVar := P + L + 1;π Exit;π end;π Inc(P, StrLen(P) + 1)π end;π GetEnvVar := nilπEnd; { GetEnvVar }ππFunction GetIntVec; assembler;π{ GETINTVEC - DOS service functionπ Description: Retrieves the address stored in the specified interrupt vectorπ Returns: A pointer to this address }πAsmπ MOV AL,IntNoπ MOV AH,35Hπ INT DOSπ MOV AX,ESπ LES DI,Vectorπ CLDπ MOV DX,BXπ XCHG AX,BXπ STOSWπ XCHG AX,BXπ STOSWπ XCHG AX,DXπEnd; { GetIntVec }ππFunction SetIntVec; assembler;π{ SETINTVEC - DOS Service functionπ Description: Sets the address in the interrupt vector table for theπ specified interruptπ Returns: The old address of the specified interrupt vector }πAsmπ LES DI,Vectorπ PUSH WORD PTR IntNoπ PUSH ESπ PUSH DIπ PUSH CSπ CALL GetIntVecπ PUSH DXπ PUSH AXπ PUSH DSπ LDS DX,Vectorπ MOV AL,IntNoπ MOV AH,25Hπ INT DOSπ POP DSπ POP AXπ POP DXπEnd; { SetIntVec }ππFunction GetDTA; assembler;π{ GETDTA - DOS service functionπ Description: Retrieves a pointer address to a DOS data exchange buffer (DTA).π By default, DTA address has the offset PSP+80h and the size ofπ 128 bytes. DTA is used to access files with the FCB method;π fn=2Fhπ Returns: A pointer address to DTA }πAsmπ MOV AH,2Fhπ INT DOSπ MOV DX,BX { store offset }π MOV AX,ES { store segment }πEnd; { GetDTA }ππFunction GetCurDisk; assembler;π{ GETCURDISK - DOS disk service functionπ Description: Retrieves number of disk currently being active; fn=19hπ Returns: Default (current, active) disk number }πAsmπ MOV AH,19hπ INT DOSπEnd; { GetCurDisk }ππFunction SetCurDisk; assembler;π{ SETCURDISK - DOS disk service functionπ Description: Sets current (default/active) drive; fn=0Ehπ Returns: Number of disks in the system }πAsmπ MOV AH,0Ehπ MOV DL,Driveπ INT DOSπEnd; { SetCurDisk }ππProcedure GetDriveAllocInfo; assembler;π{ GETDRIVEALLOCINFO - DOS disk service functionπ Description: Retrieves disk allocation information; fn=1Chπ Retrieves Info structure }πAsmπ PUSH DSπ MOV AH,1Chπ MOV DL,Driveπ INT DOSπ MOV AH,BYTE PTR [DS:BX]π LES DI,Infoπ MOV BYTE PTR ES:[DI],AH { Info.FATId }π MOV WORD PTR ES:[DI+1],DX { Info.Clusters }π MOV BYTE PTR ES:[DI+3],AL { Info.SectorsPerCluster }π MOV WORD PTR ES:[DI+4],CX { Info.BytesPerSector }π POP DSπEnd; { GetDriveAllocInfo }ππFunction GetDPB; assembler;π{ GETDPB - DOS disk service function (undocumented)π Description: Returns a block of information that is useful for applicationsπ which perform sector-level access of disk drives supported byπ device drivers; fn=32hπ Returns: 0 if successful, negative dosrInvalidDrive error code otherwiseπ Remarks: Use 0 for default drive }πAsmπ MOV DOSResult,dosrOkπ PUSH DSπ MOV AH,32hπ MOV DL,Driveπ INT DOSπ MOV WORD PTR [DPB],DSπ MOV WORD PTR [DPB+2],BXπ POP DSπ XOR AH,AHπ CMP AL,0FFhπ JNE @@1π MOV DOSResult,dosrInvalidDriveπ PUSH DOSResultπ PUSH fnGetDPBπ CALL ErrorHandlerπ MOV AX,DOSResultπ NEG AXπ@@1:πEnd; { GetDPB }ππFunction DiskSize; assembler;π{ DISKSIZE - DOS disk service functionπ Description: Retrieves total disk size; fn=36hπ Returns: Total disk size in bytes if successful, negative dosrInvalidDriveπ error code otherwiseπ Remarks: Use 0 for default drive }πAsmπ@@1:π MOV AH,36hπ MOV DL,Driveπ INT DOSπ CMP AX,0FFFFhπ JE @@2π MOV BX,DXπ IMUL CXπ IMUL BXπ JMP @@3π@@2:π MOV DOSResult,dosrInvalidDriveπ PUSH DOSResultπ PUSH fnGetDiskSizeπ CALL ErrorHandlerπ CMP AL,frRetryπ JE @@1π MOV AX,DOSResultπ NEG AXπ XOR DX,DXπ@@3:πEnd; { DiskSize }ππFunction DiskFree; assembler;π{ DISKFREE - DOS disk service functionπ Description: Retrieves amount of free disk space; fn=36hπ Returns: Amount of free disk space in bytes if successful,π negative dosrInvalidDrive error code otherwiseπ Remarks: Use 0 for default drive }πAsmπ@@1:π MOV AH,36hπ MOV DL,Driveπ INT DOSπ CMP AX,0FFFFhπ JE @@2π IMUL CXπ IMUL BXπ JMP @@3π@@2:π MOV DOSResult,dosrInvalidDriveπ PUSH DOSResultπ PUSH fnGetDiskFreeπ CALL ErrorHandlerπ CMP AL,frRetryπ JE @@1π MOV AX,DOSResultπ NEG AXπ XOR DX,DXπ@@3:πEnd; { DiskFree }ππFunction IsFixedDisk; assembler;π{ ISFIXEDDISK - DOS disk service functionπ Description: Ensures whether the specified disk is fixed or removable;π fn=4408hπ Returns: True, if the disk is fixed, False - otherwiseπ Remarks: Use 0 for default (current) drive }πAsmπ MOV AX,4408hπ MOV BL,Driveπ INT DOSπ JNC @@1π MOV DOSResult,AX { save error code in global variable }π PUSH AX { store error code }π PUSH fnIsFixedDisk { store function code }π CALL ErrorHandlerπ@@1:πEnd; { IsFixedDisk }ππFunction IsNetworkDrive; assembler;π{ ISNETWORKDRIVE - DOS disk service functionπ Description: Ensures whether the specified disk drive is a network drive;π fn=4409hπ Returns: True if drive is a network drive, False if it's a local driveπ Remarks: Use 0 for detecting the default (current) drive }πAsmπ MOV AX,4409hπ MOV BL,Driveπ INT DOSπ JNC @@1π MOV DOSResult,AX { save error code in global variable }π PUSH AX { store error code }π PUSH fnIsNetworkDrive { store function code }π CALL ErrorHandlerπ@@1:πEnd; { IsNetworkDrive }ππFunction GetDriveType(Drive : byte) : byte; assembler;π{ GETDRIVETYPE - Disk service functionπ Description: Detects the type of the specified drive. Uses IsFixedDisk andπ IsNetworkDrive functions to produce a result valueπ Returns: One of (dt) constants (see const section)π Remarks: Use 0 for detecting the default (current) drive }πAsmπ PUSH WORD PTR Driveπ CALL IsNetworkDriveπ XOR BL,BLπ CMP DOSResult,dosrOkπ JNE @@3π CMP AL,Trueπ JNE @@1π MOV BL,dtRemoteπ JMP @@3π@@1:π PUSH WORD PTR Driveπ CALL IsFixedDiskπ XOR BL,BLπ CMP DOSResult,dosrOkπ JNE @@3π CMP AL,Trueπ JNE @@2π MOV BL,dtFixedπ JMP @@3π@@2:π MOV BL,dtRemovableπ@@3:π MOV AL,BLπEnd; { GetDriveType }ππFunction CreateDir; assembler;π{ CREATEDIR - DOS directory functionπ Description: Creates a directory; fn=39hπ Returns: 0 if successful, negative DOS error code otherwise }πAsmπ@@1:π PUSH DSπ LDS DX,Dirπ MOV AH,39hπ INT DOSπ POP DSπ JC @@2π XOR AX,AXπ MOV DOSResult,dosrOkπ JMP @@3π@@2:π MOV DOSResult,AX { save error code in global variable }π PUSH AX { store error code }π PUSH fnCreateDir { store function code }π CALL ErrorHandlerπ CMP AL,frRetryπ JE @@1π POP AXπ NEG AXπ@@3:πEnd; { CreateDir }ππFunction RemoveDir; assembler;π{ REMOVEDIR - DOS directory functionπ Description: Removes (deletes) a directory; fn=3Ahπ Returns: 0 if successful, negative DOS error code otherwise }πAsmπ@@1:π PUSH DSπ LDS DX,Dirπ MOV AH,3Ahπ INT DOSπ POP DSπ JC @@2π XOR AX,AXπ MOV DOSResult,dosrOkπ JMP @@3π@@2:π MOV DOSResult,AX { save error code in global variable }π PUSH AX { store error code }π PUSH fnRemoveDir { store function code }π CALL ErrorHandlerπ CMP AL,frRetryπ JE @@1π POP AXπ NEG AXπ@@3:πEnd; { RemoveDir }ππFunction GetCurDir; assembler;π{ GETCURDIR - DOS directory functionπ Description: Retrieves current (active) directory name; fn=47hπ Returns: 0 if successful, negative DOS error code otherwise }πAsmπ@@1:π PUSH DSπ LDS SI,Dirπ MOV DL,Driveπ MOV AH,47hπ INT DOSπ POP DSπ JC @@2π XOR AX,AXπ MOV DOSResult,dosrOkπ JMP @@3π@@2:π MOV DOSResult,AX { save error code in global variable }π PUSH AX { store error code }π PUSH fnGetCurDir { store function number }π CALL ErrorHandlerπ CMP AL,frRetryπ JE @@1π POP AXπ NEG AXπ@@3:πEnd; { GetCurDir }ππFunction SetCurDir; assembler;π{ SETCURDIR - DOS directory functionπ Description: Sets current (active) directory; fn=3Bhπ Returns: 0 if successful, negative DOS error code otherwise }πAsmπ@@1:π PUSH DSπ LDS DX,Dirπ MOV AH,3Bhπ INT DOSπ POP DSπ JC @@2π XOR AX,AXπ MOV DOSResult,AXπ JMP @@3π@@2:π MOV DOSResult,AX { save error code in global variable }π PUSH AX { store error code }π PUSH fnSetCurDir { store function code }π CALL ErrorHandlerπ CMP AL,frRetryπ JE @@1π POP AXπ NEG AXπ@@3:πEnd; { SetCurDir }ππFunction DeleteFile; assembler;π{ DELETEFILE - DOS file functionπ Description: Deletes a file; fn=41hπ Returns: 0 if successful, negative DOS error code otherwise }πAsmπ@@1:π PUSH DSπ LDS DX,Pathπ MOV AH,41hπ INT DOSπ POP DSπ JC @@2π XOR AX,AXπ MOV DOSResult,dosrOkπ JMP @@3π@@2:π MOV DOSResult,AX { save error code in global variable }π PUSH AX { store error code }π PUSH fnDeleteFile { store function code }π CALL ErrorHandlerπ CMP AL,frRetryπ JE @@1π POP AXπ NEG AXπ@@3:πEnd; { DeleteFile }ππFunction RenameFile; assembler;π{ RENAMEFILE - DOS file functionπ Description: Renames/moves a file; fn=56hπ Returns: 0 if successful, negative error code otherwise }πAsmπ@@1:π PUSH DSπ LDS DX,OldPathπ LES DI,NewPathπ MOV AH,56hπ INT DOSπ POP DSπ JC @@2π XOR AX,AXπ MOV DOSResult,dosrOkπ JMP @@3π@@2:π MOV DOSResult,AX { save error code in global variable }π PUSH AX { store error code }π PUSH fnRenameFile { store function code }π CALL ErrorHandlerπ CMP AL,frRetryπ JE @@1π POP AXπ NEG AXπ@@3:πEnd; { RenameFile }ππFunction ExistsFile; assembler;π{ EXISTSFILE - DOS file functionπ Description: Determines whether the file exists; fn=4Ehπ Returns: TRUE if the file exists, FALSE - otherwise }πAsmπ PUSH DSπ LDS DX,Pathπ MOV AH,4Ehπ INT DOSπ POP DSπ JNC @@1π XOR AL,ALπ JMP @@2π@@1:π MOV AL,Trueπ@@2:πEnd; { ExistsFile }ππFunction GetFileAttr; assembler;π{ GETFILEATTR - DOS file functionπ Description: Gets file attributes; fn=43h,AL=0π Returns: File attributes if no error, negative DOS error code otherwise }πAsmπ@@1:π PUSH DSπ LDS DX,Pathπ MOV AX,4300hπ INT DOSπ POP DSπ JC @@2π MOV AX,CXπ MOV DOSResult,dosrOkπ JMP @@3π@@2:π MOV DOSResult,AX { save error code in global variable }π PUSH AX { store error code }π PUSH fnGetFileAttr { store function code }π CALL ErrorHandlerπ CMP AL,frRetryπ JE @@1π POP AXπ NEG AXπ@@3:πEnd; { GetFileAttr }ππFunction SetFileAttr; assembler;π{ SETFILEATTR - DOS file functionπ Description: Sets file attributes; fn=43h,AL=1π Returns: 0 if no error, negative DOS error code otherwise }πAsmπ@@1:π PUSH DSπ LDS DX,Pathπ MOV CX,Attrπ MOV AX,4301hπ INT DOSπ POP DSπ JC @@2π XOR AX,AXπ MOV DOSResult,dosrOkπ JMP @@3π@@2:π MOV DOSResult,AX { save error code in global variable }π PUSH AX { store error code }π PUSH fnSetFileAttr { store function code }π CALL ErrorHandlerπ CMP AL,frRetryπ JE @@1π POP AXπ NEG AXπ@@3:πEnd; { GetFileAttr }ππFunction FindFirst; assembler;π{ FINDFIRST - DOS file service functionπ Description: Searches the specified (or current) directory forπ the first entry that matches the specified filename andπ attributes; fn=4E00hπ Returns: 0 if successful, negative DOS error code otherwise }πAsmπ@@1:π PUSH DSπ LDS DX,Fπ MOV AH,1AHπ INT DOSπ POP DSπ LES DI,Pathπ MOV CX,Attrπ MOV AH,4EHπ CALL AnsiDosFuncπ MOV DOSResult,dosrOkπ JC @@2π{$IFDEF Windows}π LES DI,Fπ ADD DI,OFFSET TSearchRec.Nameπ PUSH ESπ PUSH DIπ PUSH ESπ PUSH DIπ CALL OemToAnsiπ{$ENDIF}π XOR AX,AXπ JMP @@3π@@2:π MOV DOSResult,AX { save error code in global variable }π PUSH AX { store error code }π PUSH fnFindFirst { store function code }π CALL ErrorHandlerπ CMP AL,frRetryπ JE @@1π POP AXπ@@3:π NEG AXπEnd; { FindFirst }ππFunction FindNext; assembler;π{ FINDNEXT - DOS file service functionπ Description: Returs the next entry that matches the name andπ attributes specified in a previous call to FindFirst.π The search record must be one passed to FindFirstπ Returns: 0 if successful, negative DOS error code otherwise }πAsmπ@@1:π PUSH DSπ LDS DX,Fπ MOV AH,1AHπ INT DOSπ POP DSπ MOV AH,4FHπ MOV DOSResult,dosrOkπ INT DOSπ JC @@2π{$IFDEF Windows}π LES DI,Fπ ADD DI,OFFSET TSearchRec.Nameπ PUSH ESπ PUSH DIπ PUSH ESπ PUSH DIπ CALL OemToAnsiπ{$ENDIF}π XOR AX,AXπ JMP @@3π@@2:π MOV DOSResult,AX { save error code in global variable }π PUSH AX { store error code }π PUSH fnFindNext { store function code }π CALL ErrorHandlerπ CMP AL,frRetryπ JE @@1π POP AXπ@@3:π NEG AXπEnd; { FindNext }ππProcedure UnpackTime; assembler;π{ UNPACKTIME - Service functionπ Description: Converts a 4-byte packed date/time returned byπ FindFirst, FindNext or GetFTime into a TDateTime record }πAsmπ LES DI,Tπ CLDπ MOV AX,WORD PTR [P+2]π MOV CL,9π SHR AX,CLπ ADD AX,1980π STOSWπ MOV AX,WORD PTR [P+2]π MOV CL,5π SHR AX,CLπ AND AX,15π STOSWπ MOV AX,WORD PTR [P+2]π AND AX,31π STOSWπ MOV AX,P.Word[0]π MOV CL,11π SHR AX,CLπ STOSWπ MOV AX,WORD PTR [P+2]π MOV CL,5π SHR AX,CLπ AND AX,63π STOSWπ MOV AX,WORD PTR [P]π AND AX,31π SHL AX,1π STOSWπEnd; { UnpackTime }ππFunction PackTime; assembler;π{ PACKTIME - Service functionπ Decription: Converts a TDateTime record into a 4-byte packedπ date/time used by SetFTimeπ Returns: 4-byte long integer corresponding to packed date/time }πAsmπ PUSH DSπ LDS SI,Tπ CLDπ LODSWπ SUB AX,1980π MOV CL,9π SHL AX,CLπ XCHG AX,DXπ LODSWπ MOV CL,5π SHL AX,CLπ ADD DX,AXπ LODSWπ ADD DX,AXπ LODSWπ MOV CL,11π SHL AX,CLπ XCHG AX,BXπ LODSWπ MOV CL,5π SHL AX,CLπ ADD BX,AXπ LODSWπ SHR AX,1π ADD AX,BXπ POP DSπEnd; { PackTime }ππFunction h_CreateFile; assembler;π{ H_CREATEFILE - DOS Handle file functionπ Description: Creates a file; fn=3Chπ Returns: File handle if successful, 0 if unsuccessful }πAsmπ@@1:π PUSH DSπ LDS DX,Pathπ MOV CX,0π MOV AH,5Bhπ INT DOSπ POP DSπ JC @@2π MOV DOSResult,dosrOkπ JMP @@3π@@2:π MOV DOSResult,AX { save error code in global variable }π PUSH AX { store error code }π PUSH fnCreateFile { store function code }π CALL ErrorHandlerπ CMP AL,frRetryπ JE @@1π XOR AX,AXπ@@3:πEnd; { h_CreateFile }ππFunction h_CreateTempFile; assembler;π{ H_CREATETEMPFILE - DOS Handle file functionπ Description: Creates a temporary file; fn=5Ahπ Returns: File handle if successful, 0 if unsuccessful }πAsmπ@@1:π PUSH DSπ LDS DX,Pathπ MOV CX,0 { file attribute here, 0 used for normal }π MOV AH,5Ahπ INT DOSπ POP DSπ JC @@2π MOV DOSResult,dosrOkπ JMP @@3π@@2:π MOV DOSResult,AX { save error code in global variable }π PUSH AX { store error code }π PUSH fnCreateTempFile { store function code }π CALL ErrorHandlerπ CMP AL,frRetryπ JE @@1π XOR AX,AXπ@@3:πEnd; { h_CreateTempFile }ππFunction h_OpenFile; assembler;π{ H_OPENFILE - DOS Handle file functionπ Description: Opens a file for input, output or input/output; fn=3Dhπ Returns: File handle if successful, 0 if unsuccessful }πAsmπ@@1:π PUSH DSπ LDS DX,Pathπ MOV AH,3Dhπ MOV AL,Modeπ INT DOSπ POP DSπ JC @@2π MOV DOSResult,dosrOkπ JMP @@3π@@2:π MOV DOSResult,AX { save error code in global variable }π PUSH AX { store error code }π PUSH fnOpenFile { store function code }π CALL ErrorHandlerπ CMP AL,frRetryπ JE @@1π XOR AX,AXπ@@3:πEnd; { h_OpenFile }ππFunction h_Read; assembler;π{ H_READ - DOS Handle file functionπ Description: Reads a memory block from file; fn=3Fhπ Returns: Actual number of bytes read }πAsmπ@@1:π PUSH DSπ LDS DX,Bufferπ MOV CX,Countπ MOV BX,Handleπ MOV AH,3Fhπ INT DOSπ POP DSπ MOV DOSResult,dosrOkπ JNC @@2π MOV DOSResult,AX { save error code in global variable }π PUSH AX { store error code }π PUSH fnRead { store function code }π CALL ErrorHandlerπ CMP AL,frRetryπ JE @@1π@@2:πEnd; { h_Read }ππFunction h_Write; assembler;π{ H_WRITE - DOS Handle file functionπ Description: Writes a memory block to file; fn=40hπ Returns: Actual number of bytes written }πAsmπ@@1:π PUSH DSπ LDS DX,Bufferπ MOV CX,Countπ MOV BX,Handleπ MOV AH,40hπ INT DOSπ POP DSπ MOV DOSResult,dosrOkπ JNC @@2π MOV DOSResult,AX { save error code in global variable }π PUSH AX { store error code }π PUSH fnWrite { store function code }π CALL ErrorHandlerπ CMP AL,frRetryπ JE @@1π@@2:πEnd; { h_Write }ππFunction h_Seek; assembler;π{ H_SEEK - DOS Handle file functionπ Description: Seeks to a specified file position; fn=42hπ Start is one of the (sk) constants and points to a relativeπ seek offset positionπ Returns: Current file position if successful, 0 - otherwise }πAsmπ@@1:π MOV CX,WORD PTR [SeekPos+2]π MOV DX,WORD PTR [SeekPos]π MOV BX,Handleπ MOV AL,Startπ MOV AH,42hπ MOV DOSResult,dosrOkπ INT DOSπ JNC @@2π MOV DOSResult,AX { save error code in global variable }π PUSH AX { store error code }π PUSH fnSeek { store function number }π CALL ErrorHandlerπ CMP AL,frRetryπ JE @@1π@@2:πEnd; { h_Seek }ππFunction h_FilePos;π{ H_GETPOS - DOS Handle file functionπ Description: Calls h_Seek to determine file active positionπ Returns: Current file (seek) position number in long integer }πBeginπ h_FilePos := h_Seek(Handle, 0, skPos)πEnd; { h_FilePos }ππFunction h_FileSize;π{ H_FILESIZE - DOS Handle file functionπ Description: Determines file sizeπ Returns: File size in bytes }πvar SavePos, Size : longint;πBeginπ SavePos := h_FilePos(Handle);π h_FileSize := h_Seek(Handle, 0, skEnd);π h_Seek(Handle, SavePos, skStart)πEnd; { h_FileSize }ππFunction h_Eof; assembler;π{ H_EOF - DOS Handle file functionπ Description: Checks if the current file position is equal to file sizeπ and then returns Trueπ Returns: True if end of file detected, False - otherwise }πvar Size : longint;πAsmπ PUSH Handleπ CALL h_FileSize { Get file size in AX:DX }π MOV WORD PTR [Size],AX { Store high word }π MOV WORD PTR [Size+2],DX { Store low word }π PUSH Handleπ CALL h_FilePos { Get current file position }π XOR CL,CLπ CMP AX,WORD PTR [Size]π JNE @@1π CMP DX,WORD PTR [Size+2]π JNE @@1π MOV CL,Trueπ@@1:π MOV AL,CLπEnd; { h_GetPos }ππFunction h_GetFTime; assembler;π{ H_GETFTIME - DOS Handle file functionπ Description: Returns file update date and time values; fn=5700hπ Returns: Date and time values in long integerπ or negative DOS error code if an error occured }πAsmπ@@1:π MOV BX,Handleπ MOV AX,5700h { read date and time }π MOV DOSResult,dosrOkπ INT DOSπ JNC @@2π MOV DOSResult,AX { save error code in global variable }π PUSH AX { store error code }π PUSH fnGetFDateTime { store function number }π CALL ErrorHandlerπ CMP AL,frRetryπ JE @@1π POP AXπ NEG AXπ@@2:πEnd; { h_GetFTime }ππFunction h_SetFTime; assembler;π{ H_SETFTIME - DOS Handle file functionπ Description: Sets file date and time; fn=5701hπ Returns: New date and time values in long integerπ or negative DOS error code if an error occured }πAsmπ@@1:π MOV CX,WORD PTR [DateTime]π MOV DX,WORD PTR [DateTime+2]π MOV BX,Handleπ MOV AX,5701h { read date and time }π MOV DOSResult,dosrOkπ INT DOSπ JNC @@2π MOV DOSResult,AX { save error code in global variable }π PUSH AX { store error code }π PUSH fnSetFDateTime { store function number }π CALL ErrorHandlerπ CMP AL,frRetryπ JE @@1π POP AXπ NEG AXπ@@2:πEnd; { h_SetFTime }ππFunction h_CloseFile; assembler;π{ H_CLOSEFILE - DOS Handle file functionπ Description: Closes open file; fn=3Ehπ Returns: 0 if successful, negative DOS error code otherwise }πAsmπ@@1:π MOV BX,Handleπ MOV AH,3Ehπ INT DOSπ JC @@2π XOR AX,AXπ MOV DOSResult,dosrOkπ JMP @@3π@@2:π MOV DOSResult,AX { save error code in global variable }π PUSH AX { store error code }π PUSH fnCloseFile { store function number }π CALL ErrorHandlerπ CMP AL,frRetryπ JE @@1π POP AXπ NEG AXπ@@3:πEnd; { h_CloseFile }ππFunction MemAlloc; assembler;πAsmπ@@1:π MOV DOSResult,dosrOkπ MOV AX,WORD PTR [Size]π MOV DX,WORD PTR [Size+2]π MOV CX,16π DIV CXπ INC AXπ MOV BX,AXπ MOV AH,48hπ INT DOSπ JNC @@2π MOV DOSResult,AX { save error code in global variable }π PUSH AX { store error code }π PUSH fnMemAlloc { store function number }π CALL ErrorHandlerπ CMP AL,frRetryπ JE @@1π XOR AX,AXπ@@2:π MOV DX,AXπ XOR AX,AXπEnd; { MemAlloc }ππFunction MemFree; assembler;πAsmπ MOV DOSResult,dosrOkπ MOV ES,WORD PTR [P+2]π MOV AH,49hπ INT DOSπ JNC @@1π MOV DOSResult,AXπ PUSH AXπ PUSH fnMemFreeπ CALL ErrorHandlerπ@@1:π MOV AX,DOSResultπ NEG AXπEnd; { MemFree }ππFunction FileSearch; assembler;π{ FileSearch searches for the file given by Name in the list of }π{ directories given by List. The directory paths in List must }π{ be separated by semicolons. The search always starts with the }π{ current directory of the current drive. If the file is found, }π{ FileSearch stores a concatenation of the directory path and }π{ the file name in Dest. Otherwise FileSearch stores an empty }π{ string in Dest. The maximum length of the result is defined }π{ by the fsPathName constant. The returned value is Dest. }πAsmπ PUSH DSπ CLDπ LDS SI,Listπ LES DI,Destπ MOV CX,fsPathNameπ@@1:π PUSH DSπ PUSH SIπ JCXZ @@3π LDS SI,Nameπ@@2:π LODSBπ OR AL,ALπ JE @@3π STOSBπ LOOP @@2π@@3:π XOR AL,ALπ STOSBπ LES DI,Destπ MOV AX,4300Hπ CALL AnsiDosFuncπ POP SIπ POP DSπ JC @@4π TEST CX,18Hπ JE @@9π@@4:π LES DI,Destπ MOV CX,fsPathNameπ XOR AH,AHπ LODSBπ OR AL,ALπ JE @@8π@@5:π CMP AL,';'π JE @@7π JCXZ @@6π MOV AH,ALπ STOSBπ DEC CXπ@@6:π LODSBπ OR AL,ALπ JNE @@5π DEC SIπ@@7:π JCXZ @@1π CMP AH,':'π JE @@1π MOV AL,'\'π CMP AL,AHπ JE @@1π STOSBπ DEC CXπ JMP @@1π@@8:π STOSBπ@@9:π MOV AX,WORD PTR [Dest]π MOV DX,WORD PTR [Dest+2]π POP DSπEnd; { FileSearch }ππFunction FileExpand; assembler;π{ FileExpand fully expands the file name in Name, and stores }π{ the result in Dest. The maximum length of the result is }π{ defined by the fsPathName constant. The result is an all }π{ upper case string consisting of a drive letter, a colon, a }π{ root relative directory path, and a file name. Embedded '.' }π{ and '..' directory references are removed, and all name and }π{ extension components are truncated to 8 and 3 characters. The }π{ returned value is Dest. }ππAsmπ PUSH DSπ CLDπ LDS SI,Nameπ LEA DI,TempStrπ PUSH SSπ POP ESπ LODSWπ OR AL,ALπ JE @@1π CMP AH,':'π JNE @@1π CMP AL,'a'π JB @@2π CMP AL,'z'π JA @@2π SUB AL,20Hπ JMP @@2π@@1:π DEC SIπ DEC SIπ MOV AH,19Hπ INT DOSπ ADD AL,'A'π MOV AH,':'π@@2:π STOSWπ CMP [SI].Byte,'\'π JE @@3π SUB AL,'A'-1π MOV DL,ALπ MOV AL,'\'π STOSBπ PUSH DSπ PUSH SIπ MOV AH,47Hπ MOV SI,DIπ PUSH ESπ POP DSπ INT DOSπ POP SIπ POP DSπ JC @@3π XOR AL,ALπ CMP AL,ES:[DI]π JE @@3π{$IFDEF Windows}π PUSH ESπ PUSH ESπ PUSH DIπ PUSH ESπ PUSH DIπ CALL OemToAnsiπ POP ESπ{$ENDIF}π MOV CX,0FFFFHπ XOR AL,ALπ CLDπ REPNE SCASBπ DEC DIπ MOV AL,'\'π STOSBπ@@3:π MOV CX,8π@@4:π LODSBπ OR AL,ALπ JE @@7π CMP AL,'\'π JE @@7π CMP AL,'.'π JE @@6π JCXZ @@4π DEC CXπ{$IFNDEF Windows}π CMP AL,'a'π JB @@5π CMP AL,'z'π JA @@5π SUB AL,20Hπ{$ENDIF}π@@5:π STOSBπ JMP @@4π@@6:π MOV CL,3π JMP @@5π@@7:π CMP ES:[DI-2].Word,'.\'π JNE @@8π DEC DIπ DEC DIπ JMP @@10π@@8:π CMP ES:[DI-2].Word,'..'π JNE @@10π CMP ES:[DI-3].Byte,'\'π JNE @@10π SUB DI,3π CMP ES:[DI-1].Byte,':'π JE @@10π@@9:π DEC DIπ CMP ES:[DI].Byte,'\'π JNE @@9π@@10:π MOV CL,8π OR AL,ALπ JNE @@5π CMP ES:[DI-1].Byte,':'π JNE @@11π MOV AL,'\'π STOSBπ@@11:π LEA SI,TempStrπ PUSH SSπ POP DSπ MOV CX,DIπ SUB CX,SIπ CMP CX,79π JBE @@12π MOV CX,79π@@12:π LES DI,Destπ PUSH ESπ PUSH DIπ{$IFDEF Windows}π PUSH ESπ PUSH DIπ{$ENDIF}π REP MOVSBπ XOR AL,ALπ STOSBπ{$IFDEF Windows}π CALL AnsiUpperπ{$ENDIF}π POP AXπ POP DXπ POP DSπEnd; { FileExpand }ππ{$W+}πFunction FileSplit;π{ FileSplit splits the file name specified by Path into its }π{ three components. Dir is set to the drive and directory path }π{ with any leading and trailing backslashes, Name is set to the }π{ file name, and Ext is set to the extension with a preceding }π{ period. If a component string parameter is NIL, the }π{ corresponding part of the path is not stored. If the path }π{ does not contain a given component, the returned component }π{ string is empty. The maximum lengths of the strings returned }π{ in Dir, Name, and Ext are defined by the fsDirectory, }π{ fsFileName, and fsExtension constants. The returned value is }π{ a combination of the fcDirectory, fcFileName, and fcExtension }π{ bit masks, indicating which components were present in the }π{ path. If the name or extension contains any wildcard }π{ characters (* or ?), the fcWildcards flag is set in the }π{ returned value. }πvarπ DirLen, NameLen, Flags : word;π NamePtr, ExtPtr : PChar;πbeginπ NamePtr := StrRScan(Path, '\');π if NamePtr = nil then NamePtr := StrRScan(Path, ':');π if NamePtr = nil then NamePtr := Path else Inc(NamePtr);π ExtPtr := StrScan(NamePtr, '.');π if ExtPtr = nil then ExtPtr := StrEnd(NamePtr);π DirLen := NamePtr - Path;π if DirLen > fsDirectory then DirLen := fsDirectory;π NameLen := ExtPtr - NamePtr;π if NameLen > fsFilename then NameLen := fsFilename;π Flags := 0;π if (StrScan(NamePtr, '?') <> nil) or (StrScan(NamePtr, '*') <> nil) thenπ Flags := fcWildcards;π if DirLen <> 0 then Flags := Flags or fcDirectory;π if NameLen <> 0 then Flags := Flags or fcFilename;π if ExtPtr[0] <> #0 then Flags := Flags or fcExtension;π if Dir <> nil then StrLCopy(Dir, Path, DirLen);π if Name <> nil then StrLCopy(Name, NamePtr, NameLen);π if Ext <> nil then StrLCopy(Ext, ExtPtr, fsExtension);π FileSplit := Flags;πEnd; { FileSplit }π{$W-}ππFunction StdErrorProc(ErrCode : integer; FuncCode : word) : byte; far;πassembler;π{ Default error handler procedure called from EnhDOS functions }πAsmπ MOV AL,frOk { Return zero }πEnd; { StdErrorProc }πππconst WrongDOSVersion : PChar = 'DOS 3.1 or greater required.'#13#10'$';ππBeginπ asmπ MOV AH,30h { Get DOS version }π INT DOSπ CMP AL,3π JGE @@continue { if greater than or equal to 3 then continue else exit }π PUSH DSπ LDS DX,WrongDOSVersionπ MOV AH,09hπ INT DOSπ MOV AH,4Chπ INT DOSπ @@continue:π LES DI,Copyrightπ end;π DOSResult := dosrOk;π SetErrorHandler(StdErrorProc)πEnd. { EnhDOS+ }ππ{ ------------------------------------- DEMO ------------------ }π{ ***** ENHDDEMO.PAS ***** }ππProgram DemoEnhDOS;π{ Copyright (c) 1994 by Andrew Eigus Fido Net 2:5100/33 }π{ EnhDOS+ (Int21) demo program }ππ{$M 8192,0,0}π{ no heap size, couz using own memeory allocation }ππ(* Simple copy file program *)ππuses EnhDOS, Strings;ππconst BufSize = 65535; { may be larger; you may allocate more }ππvarπ Buffer : pointer;π InputFile, OutputFile : array[0..63] of Char;π Handle1, Handle2 : THandle;π BytesRead : word;ππFunction Int21ErrorHandler(ErrCode : integer; FuncCode : word) : byte; far;πvar fn : array[0..20] of Char;πBeginπ case FuncCode ofπ fnOpenFile: StrCopy(fn, 'h_OpenFile');π fnCreateFile: StrCopy(fn, 'h_CreateFile');π fnRead: StrCopy(fn, 'h_Read');π fnWrite: StrCopy(fn, 'h_Write');π fnSeek: StrCopy(fn, 'h_Seek');π fnCloseFile: StrCopy(fn, 'h_CloseFile');π fnMemAlloc: StrCopy(fn, 'MemAlloc');π fnDeleteFile: Exit;π else fn[0] := #0π end;π WriteLn('DOS Error ', ErrCode, ' in function ', FuncCode, ' (', fn, ')');π { actually for function return code see fr consts in the EnhDOS constπ section }πEnd; { Int21ErrorHandler }ππBeginπ SetErrorHandler(Int21ErrorHandler);ππ WriteLn('EnhDOS+ demo program: copies one file to another');π repeatπ if ParamCount > 0 thenπ StrPCopy(InputFile, ParamStr(1))π elseπ beginπ Write('Enter file name to read from: ');π ReadLn(InputFile)π end;π if ParamCount > 1 thenπ StrPCopy(OutputFile, ParamStr(2))π elseπ beginπ Write('Enter file name to write to: ');π ReadLn(OutputFile)π end;π WriteLnπ until (StrLen(InputFile) > 0) and (StrLen(OutputFile) > 0);ππ if not ExistsFile(InputFile) thenπ beginπ WriteLn('File not found: ', InputFile);π Halt(1)π end;ππ Buffer := MemAlloc(BufSize);ππ Write('Copying... ');ππ Handle1 := h_OpenFile(InputFile, omRead);π if Handle1 <> 0 thenπ beginπ DeleteFile(OutputFile);π Handle2 := h_CreateFile(OutputFile);π if Handle2 <> 0 thenπ beginπ BytesRead := 1;ππ while (BytesRead > 0) and (DOSResult = dosrOk) doπ beginπ BytesRead := h_Read(Handle1, Buffer^, BufSize);ππ if DOSResult <> dosrOk thenπ { read error then }π WriteLn('Error reading from input file');ππ if h_Write(Handle2, Buffer^, BytesRead) <> BytesRead thenπ { write error then }π beginπ WriteLn('Error writing to output file');π DOSResult := $FFπ endπ end;π if DOSResult = dosrOk then WriteLn('File copied OK');π h_CloseFile(Handle2)π end;π h_CloseFile(Handle1)π end;ππ MemFree(Buffer)πEnd. { DemoEnhDOS }ππ 3 08-24-9413:35ALL JON PHIPPS Environment detection SWAG9408 ¼─╝ 37 ┤φ π{πAnswering a msg of <Thursday May 19 1994>, from Elad Nachman to Per-EricπLarsson:π}ππprogram environ;ππuses dos,crt;ππConstπ Multiplex = $2f;π std_dos = $21;πππvarπ regs : registers;π {windows information variables}π winstall : boolean;π hi_winver : integer;π lo_winver : integer;π _386enh : boolean;π Ver_mach : word;π {OS information Variables}π _4dosinst : boolean;π Hi_4d_ver : integer;π Lo_4d_ver : integer;π shell_num : integer;π Hi_dosver : integer;π Lo_dosver : integer;π {DesqView Information variables}π dv_inst : boolean;π Hi_dv_ver : integer;π Lo_dv_ver : integer;πππ procedure v_id; {return windows 3.x 386enh mode virtual machine number}ππ beginπ regs.ax:=$1638;π intr(multiplex,regs);π ver_mach := regs.bx;π end;ππ procedure winstal;{check for windows 3.x install}ππ beginπ regs.ax:=$160A;π intr(multiplex,regs);π if regs.ax = $0000 thenπ beginπ winstall := true;π Hi_winver := regs.bh;π lo_winver := regs.bl;π if regs.cx = $0003 thenπ beginπ _386enh := true;π v_id;π endπ elseπ beginπ _386enh := false;π ver_mach := 0;π end;π endπ elseπ beginπ {π this point is only reached if windows isNOTπ detected we therefore set ALL windows id varsπ to impossible numbers.π }π winstall := false;π Hi_winver := 0;π lo_winver := 0;π ver_mach := 0;π end;π end;ππ procedure dvinstall;{check for dv}ππ beginπ if winstall thenπ beginπ dv_inst := false;π exit;π end;π regs.ax := $2b00;π regs.cx := $4445;π regs.dx := $5351;π regs.ax := $0001;π intr(std_dos,regs);π if regs.al<>$ff thenπ beginπ hi_dv_ver := regs.bh;π lo_dv_ver := regs.bl;π dv_inst := true;π endπ elseπ beginπ Hi_dv_ver := 0;π Lo_dv_ver := 0;π dv_inst := false;π end;π end; { dv install check}ππ procedure I_4dos;ππ beginπ regs.ax := $d44d;π regs.bx := $0000;π intr(std_dos,regs);π if regs.ax = $44dd thenπ beginπ hi_4d_ver := regs.bh;π lo_4d_ver := regs.bl;π _4dosinst := true;π shell_num := regs.dl;π endπ elseπ begin { no 4dos }π _4dosinst := false;π hi_4d_ver := 0;π lo_4d_ver := 0;π shell_num := -1;π end;π end;ππ procedure dos_ver; {get dos version}ππ beginπ regs.ax:=$3001;π intr(std_dos,regs);π hi_dosver:=regs.al;π lo_dosver:=regs.ah;π end;ππ procedure display_info;π beginπ clrscr;π gotoxy(4,5);π writeln('Os information');π gotoxy(4,12);π writeln('Windows 3.x information');π gotoxy(4,17);π writeln('Dv information');π if _4dosinst thenπ beginπ gotoxy(6,7);π writeln('4dos version: ',hi_4d_ver,':',lo_4d_ver);π gotoxy(6,8);π writeln('4dos subshell#: ',shell_num);π gotoxy(6,9);π writeln('MSdos version: ',hi_dosver,':',lo_dosver);π endπ elseπ beginπ gotoxy(6,7);π writeln('MSdos version: ',hi_dosver,':',lo_dosver);π gotoxy(6,8);π writeln('4dos.com not detected in this window.');π end;π if winstall thenπ beginπ gotoxy(6,13);π writeln('Windows Version: ',Hi_winver,':',lo_winver);π gotoxy(6,14);π if _386enh thenπ beginπ writeln('Running in 386 enhanced mode');π gotoxy(6,15);π writeln('386Enh virtual machine ID: ',ver_mach);π endπ elseπ beginπ writeln('Running in Standard mode');π gotoxy(6,15);π writeln('386Enh Virtual Machine ID: Not applicable in standard mode');π end;π endπ elseπ beginπ gotoxy(6,13);π writeln('Microsoft windows not installed');π end;π if dv_inst thenπ beginπ gotoxy(6,18);π writeln('Desqview Version: ',hi_dv_ver,':',lo_dv_ver);π endπ elseπ beginπ gotoxy(6,18);π writeln('DesqView not installed');π end;π end;ππ beginπ winstal;π I_4dos;π dos_ver;π dvinstall;π display_info;π repeatπ until readkey = #27;π end.ππ 4 08-24-9413:35ALL JEFF WILSON Error to file SWAG9408 r ╧Ω 45 ┤φ {πHere is a unit that I've played with a bit.. I have no idea who the originalπauthor is. What it does is expand the Runtime Errors reported by TP andπoptionally logs it to a file that you supply the name to.. It works fine forπme on MSDOS 3.3 and 5.0. If you make any improvements to it I wouldπappreciate a copy of it..π}ππ{$S-}πUNIT Errors ;ππINTERFACEππUSESπ Dos ;ππVARπ ErrorFile : PathStr ; { optional name you include in the }π { main program code }πPROCEDURE CheckRTError ;ππIMPLEMENTATIONππVARπ ErrorExitProc : Pointer ;ππFUNCTION HexStr(w: Word): String ;π CONSTπ HexChars : Array [0..$F] of Char = '0123456789ABCDEF' ;π BEGINπ HexStr := HexChars[Hi(w) shr 4]π + HexChars[Hi(w) and $F]π + HexChars[Lo(w) shr 4]π + HexChars[Lo(w) and $F] ;π END ;ππFUNCTION ExtendedError: String ; { goto DOS to get the last reported error }π VARπ Regs : Registers ;π BEGINπ FillChar(Regs,Sizeof(Regs),#0) ;π Regs.AH := $59 ;π MSDos(Regs) ;π CASE Regs.AX OFπ $20 : ExtendedError := 'Share Violation' ;π $21 : ExtendedError := 'Lock Violation' ;π $23 : ExtendedError := 'FCB Unavailable' ;π $24 : ExtendedError := 'Sharing Buffer Overflow' ;π ELSE ExtendedError := 'Extended Error ' + HexStr(Regs.AX) ;π END ; { case }π END ;ππFUNCTION ErrorMsg(Err : Integer): String ;πBEGINπ CASE Err OFπ 1 : ErrorMsg := 'Invalid Function Number';π 2 : ErrorMsg := 'File Not Found';π 3 : ErrorMsg := 'Path Not Found';π 4 : ErrorMsg := 'Too Many Open Files';π 5 : ErrorMsg := 'File Access Denied';π 6 : ErrorMsg := 'Invalid File Handle';ππ 12 : ErrorMsg := 'Invalid File Access Code';ππ 15 : ErrorMsg := 'Invalid Drive Number';π 16 : ErrorMsg := 'Cannot Remove Current Directory';π 17 : ErrorMsg := 'Cannot Rename Across Drives';π 18 : ErrorMsg := 'No More Files';ππ 100 : ErrorMsg := 'Disk Read Past End Of File';π 101 : ErrorMsg := 'Disk Full';π 102 : ErrorMsg := 'File Not Assigned';π 103 : ErrorMsg := 'File Not Open';π 104 : ErrorMsg := 'File Not Open For Input';π 105 : ErrorMsg := 'File Not Open For Output';π 106 : ErrorMsg := 'Invalid Numeric Format';ππ 150 : ErrorMsg := 'Disk is write protected';π 151 : ErrorMsg := 'Unknown Unit';π 152 : ErrorMsg := 'Drive Not Ready';π 153 : ErrorMsg := 'Unknown command';π 154 : ErrorMsg := 'CRC Error in data';π 155 : ErrorMsg := 'Bad drive request structure length';π 156 : ErrorMsg := 'Disk seek error';π 157 : ErrorMsg := 'Unknown media type';π 158 : ErrorMsg := 'Sector not found';π 159 : ErrorMsg := 'Printer out of paper';π 160 : ErrorMsg := 'Device write fault';π 161 : ErrorMsg := 'Device read fault';π 162 : ErrorMsg := 'Hardware failure';ππ 163 : ErrorMsg := ExtendedError ;ππ 200 : ErrorMsg := 'Division by zero';π 201 : ErrorMsg := 'Range check error';π 202 : ErrorMsg := 'Stack overflow error';π 203 : ErrorMsg := 'Heap overflow error';π 204 : ErrorMsg := 'Invalid pointer operation';π 205 : ErrorMsg := 'Floating point overflow';π 206 : ErrorMsg := 'Floating point underflow';π 207 : ErrorMsg := 'Invalid floating point operation';π 208 : ErrorMsg := 'Overlay manager not installed';π 209 : ErrorMsg := 'Overlay file read error';π 210 : ErrorMsg := 'Object not initialized';π 211 : ErrorMsg := 'Call to abstract method';π 212 : ErrorMsg := 'Stream registration error';π 213 : ErrorMsg := 'Collection index out of range';π 214 : ErrorMsg := 'Collection overflow error';π 215 : ErrorMsg := 'Arithmetic overflow error';π 216 : ErrorMsg := 'General protection fault';π END ;πEND ;ππFUNCTION LZ(W : Word): String ;π VARπ s : String ;π BEGINπ Str(w:0,s) ;π IF Length(s) = 1 THEN s := '0' + s ;π LZ := s ;π END ;ππFUNCTION TodayDate : String ;π VARπ Year,π Month,π Day,π Dummy,π Hour,π Minute,π Second : Word ;π BEGINπ GetDate(Year, Month, Day, Dummy) ;π GetTime(Hour, Minute, Second, Dummy) ;π TodayDate := LZ(Month) + '/' + LZ(Day) + '/' + LZ(Year-1900)π + ' ' + LZ(Hour) + ':' + LZ(Minute) ;π END ;ππ{$F+}πPROCEDURE CheckRTError ;π VARπ F : Text ;π BEGINπ IF ErrorAddr <> Nil THENπ BEGINπ IF ErrorFile <> '' THENπ BEGINπ Assign(F,ErrorFile) ;π {$I-} Append(F) ; {$I+}π IF IOResult <> 0 THEN Rewrite(F) ;π Writeln(F,'Date: ' + TodayDate) ;π Write(F,'RunTime Error #',ExitCode,' at ') ;π Write(F,HexStr(Seg(ErrorAddr^)) + ':') ;π WriteLn(F,HexStr(Ofs(ErrorAddr^))) ;π Writeln(F,ErrorMsg(ExitCode)) ;π Writeln(F,'') ;π Close(F) ;π END ;π Writeln('Date: ' + TodayDate) ;π Write('RunTime Error #',ExitCode,' at ') ;π Write(HexStr(Seg(ErrorAddr^)) + ':') ;π WriteLn(HexStr(Ofs(ErrorAddr^))) ;π Writeln(ErrorMsg(ExitCode)) ;π Writeln ;π ErrorAddr := Nil ; { reset variable so TP doesn't report }π ExitProc := ErrorExitProc ; { the error and reset the Exit Pointer }π END ;π END ;π{$F-}ππBEGINπ ErrorFile := '' ; { don't log the error to a file }π ErrorExitProc := ExitProc ;π ExitProc := @CheckRTError ;πEND.ππ{============== DEMO ==============}ππPROGRAM Test ;ππUSESπ Errors ;ππVARπ TestFile : Text ;ππBEGINπ ErrorFile := 'TESTERR.TXT' ; { log errors to this file }π RunError(3) ; { test whatever you want }πEND.ππ 5 08-24-9413:35ALL MARIUS ELLEN Additions to ENHDOS SWAG9408 $ 4j 48 ┤φ πfunction PathTest(Pth:pchar):word;πassembler;πasmπ CLD; LES DI,Pthπ XOR AX,AXπ MOV CX,0FFFFHπ REPNE SCASB; NOT CX; JCXZ @NoAst; DEC DI; MOV DX,DI; STDπ MOV BX,CX; MOV SI,DI; MOV AL,'.'; REPNE SCASB; JNE @Uπ OR AH,fcExtensionπ INC DI; MOV DX,DIπ@U: MOV CX,BX; MOV DI,SI; MOV AL,'\'; REPNE SCASB; JE @Fπ MOV CX,BX; MOV DI,SI; MOV AL,':'; REPNE SCASB; JNE @Gπ@F: INC DIπ@G: INC DIπ CMP DX,DI; JE @NoNamπ OR AH,fcFileNameπ@NoNam: MOV CX,BX; MOV DI,SI; MOV AL,'\'; REPNE SCASB; JNE @NoPthπ OR AH,fcDirectoryπ@NoPth: MOV CX,BX; MOV DI,SI; MOV AL,':'; REPNE SCASB; JNE @NoDrvπ OR AH,fcDriveπ@NoDrv: MOV CX,BX; MOV DI,SI; MOV AL,'?'; REPNE SCASB; JNE @NoQstπ OR AH,fcWildcardsπ@NoQst: MOV CX,BX; MOV DI,SI; MOV AL,'*'; REPNE SCASB; JNE @NoAstπ OR AH,fcWildcardsπ@NoAst: MOV AL,AHπ XOR AH,AHπend;ππfunction PathBuild(Dst,Pth,Nam,Ext:PChar):PChar;πassembler;πasmπ CLDπ PUSH DSπ XOR AL,ALπ XOR CX,CX; LES DI,Extπ MOV DX,ES; AND DX,DX; JE @NoExtπ DEC CX; REPNE SCASB;π NOT CX; DEC CXπ@NoExt: PUSH CXπ XOR CX,CX; LES DI,Namπ MOV DX,ES; AND DX,DX; JE @NoNamπ DEC CX; REPNE SCASBπ NOT CX; DEC CXπ@NoNam: PUSH CXπ XOR CX,CX; LES DI,Pthπ MOV DX,ES; AND DX,DX; JE @NoPthπ DEC CX; REPNE SCASBπ NOT CX; DEC CXπ@NoPth:π LES DI,Dstπ MOV BX,DIπ LDS SI,Pthπ REP MOVSBπ LDS SI,Namπ POP CXπ REP MOVSBπ LDS SI,Extπ POP CXπ REP MOVSBπ STOSBπ MOV DX,ESπ MOV AX,BXπ POP DSπend;ππprocedure PathSplit(Pth,Dir,Nam,Ext:pchar);πassembler;πasmπ PUSH DSπ LES DI,Pth; CLDπ MOV CX,0FFFFHπ XOR AL,AL; REPNE SCASB; NOT CX; DEC DI; MOV BX,DI; STDπ MOV SI,CX; MOV DX,DI; MOV AL,'.'; REPNE SCASB; JNE @Uπ INC DI; MOV BX,DIπ@U: MOV CX,SI; MOV DI,DX; MOV AL,'\'; REPNE SCASB; JE @Fπ MOV CX,SI; MOV DI,DX; MOV AL,':'; REPNE SCASB; JNE @Gπ@F: INC DIπ@G: INC DIπ LDS SI,Pth; CLDπ MOV CX,fsDirectoryπ SUB DI,SI; CMP DI,CX; JA @3; XCHG DI,CXπ@3: LES DI,Dir; MOV AX,ES; AND AX,AX; JE @NoDirπ REP MOVSB; XOR AL,AL; STOSBπ@NoDir: ADD SI,CXπ MOV CX,fsFilenameπ MOV AX,BX; SUB AX,SI; CMP AX,CX; JA @4; XCHG AX,CXπ@4: LES DI,Nam; MOV AX,ES; AND AX,AX; JE @NoNamπ REP MOVSB; XOR AL,AL; STOSBπ@NoNam: ADD SI,CXπ MOV CX,fsExtensionπ MOV AX,DX; SUB AX,SI; CMP AX,CX; JA @5; XCHG AX,CXπ@5: LES DI,Ext; MOV AX,ES; AND AX,AX; JE @NoExtπ REP MOVSB; XOR AL,AL; STOSBπ@NoExt: POP DSπend;ππprocedure PathSplitName(Pth,Dir,NamExt:pchar);πassembler;πasmπ PUSH DSπ LES DI,Pth; CLDπ MOV CX,0FFFFHπ XOR AL,AL; REPNE SCASB; NOT CX; DEC DI; STDπ MOV SI,CX; MOV BX,DI; MOV AL,'\'; REPNE SCASB; JE @Fπ MOV CX,SI; MOV DI,BX; MOV AL,':'; REPNE SCASB; JNE @Gπ@F: INC DIπ@G: INC DIπ LDS SI,Pth; CLDπ MOV CX,fsDirectoryπ SUB DI,SI; CMP DI,CX; JA @3; XCHG DI,CXπ@3: LES DI,Dir; MOV AX,ES; AND AX,AX; JE @NoDirπ REP MOVSB; XOR AL,AL; STOSBπ@NoDir: ADD SI,CXπ MOV CX,fsFilename+fsExtensionπ MOV AX,BX; SUB AX,SI; CMP AX,CX; JA @4; XCHG AX,CXπ@4: LES DI,NamExt; MOV AX,ES; AND AX,AX; JE @NoNamπ REP MOVSB; XOR AL,AL; STOSBπ@NoNam: POP DSπend;ππ{πIs't a pitty you did not include some cacheable reads/writes in your unitπENHDOS. Also some functions could be included using USES windos. (Or my ownπbputils ;-) Here's some cacheable stuff (also protected mode).π}ππfunction fLargeRead(Handle:word;MemPtr:pointer;Size:longint):longint;π{read Size bytes from a file to Seg:0, return bytes read}πassembler;πvar Sg:word absolute Handle;πasmπ PUSH DSπ MOV CX,$8000π MOV BX,Handleπ MOV AX,SelectorIncπ MOV DI,Size.word[2]π MOV SI,Size.word[0]π MOV Sg,AXπ LDS DX,MemPtrπ AND DX,DX; JE @Stπ MOV AX,267π@Er: {Halt(error)}π POP DSπ PUSH AXπ CALL bpHaltNrπ@Re: AND DI,DI; JNE @Doπ CMP SI,CX; JA @Do; MOV CX,SIπ@Do: MOV AH,$3F; INT 21H; JC @Erπ SUB SI,AX; SBB DI,0π SUB AX,CX; JNE @Eoπ ADD DX,CX; JNC @Stπ MOV AX,DS; ADD AX,Sg; MOV DS,AXπ@St: MOV AX,DI; XOR AX,SI; JNE @Reπ@Eo: POP DSπ MOV AX,Size.word[0]; SUB AX,SIπ MOV DX,Size.word[2]; SBB DX,DIπ@eX:πend;πππfunction fLargeWrite(Handle:word;MemPtr:pointer;Size:longint):longint;π{write Size bytes to a file from Seg:0, return bytes written}πassembler;πvar Sg:word absolute Handle;πasmπ PUSH DSπ MOV CX,$8000π MOV BX,Handleπ MOV AX,SelectorIncπ MOV DI,Size.word[2]π MOV SI,Size.word[0]π MOV Sg,AXπ LDS DX,MemPtrπ AND DX,DX; JE @Stπ MOV AX,267π JMP @Erπ@Wr: MOV AX,101π@Er: {Halt(error)}π POP DSπ PUSH AXπ CALL bpHaltNrπ@Re: AND DI,DI; JNE @Doπ CMP SI,CX; JA @Do; MOV CX,SIπ@Do: MOV AH,$40; INT 21H; JC @Erπ SUB SI,AX; SBB DI,0π SUB AX,CX; JNE @Wrπ ADD DX,CX; JNC @Stπ MOV AX,DS; ADD AX,Sg; MOV DS,AXπ@St: MOV AX,DI; XOR AX,SI; JNE @Reπ@Eo: POP DSπ MOV AX,Size.word[0]; SUB AX,SIπ MOV DX,Size.word[2]; SBB DX,DIπ@eX:πend;π 6 08-24-9413:36ALL ANDREW EIGUS FASTEST File Exist (BASM)SWAG9408 ;V▄L 6 ┤φ πFunction FileExists(FileName : string) : boolean; assembler;π{ Determines whether the given file exists. Returns true if the file was found,π false - if there is no such file }πAsmπ PUSH DSπ LDS DX,FileNameπ INC DXπ MOV AX,4300h { get information through the GetAttr function }π INT 21hπ MOV AL,False { emulate AL=0 }π JC @@1π INC AL { emulate AL=AL+1=1 }π@@1:π POP DSπEnd; { FileExists }ππconst Found : array[Boolean] of string[10] = ('not found', 'found');πvar FileName : string;ππBeginπ Write('Enter file name to search: ');π ReadLn(FileName);π WriteLn('File "', FileName, '" ', Found[FileExists(FileName)], '.');πEnd.π 7 08-24-9413:36ALL STEVE ROGERS Extended SearchRec SWAG9408 ╠9╡Ç 12 ┤φ {π OK, here's a problem. FExpand takes Newest.Name and appends it to theπ full CURRENT path, not the path you specified on the command line. Youπ have to keep track of that path yourself. Or, here's a unit that mightπ help. It's an Expanded Searchrec that returns a full filespec.π}ππunit EXSRec;π{ Written by Steve Rogers - 1994. Released to public domain }ππinterfaceπusesπ dos;ππtypeπ EXSearchRec = record { EXtended searchrec }π name : pathstr; { fully specified filename }π dsub : searchrec; { dos.searchrec }π end;ππprocedure ffirst(path : pathstr;attr : word;var dd : EXSearchRec);πprocedure fnext(var dd : EXSearchRec);ππimplementationππprocedure ffirst(path : pathstr;attr : word;var dd : EXSearchRec);πbeginπ findfirst(path,attr,dd.dsub);π if (doserror=0) then with dd do beginπ name:= path;π while not (name[length(name)] in ['\',':',#0])π do dec(name[0]);π name:= name+dsub.name;π end else dd.name:= '';πend;ππ{----------------------}πprocedure fnext(var dd : EXSearchRec);ππbeginπ findnext(dd.dsub);π if (doserror=0) then with dd do beginπ while not (dd.name[length(dd.name)] in ['\',':',#0])π do dec(name[0]);π name:= name+dsub.name;π end else dd.name:= '';πend;ππ{----------------------}πend.π 8 08-24-9413:37ALL ANDREW EIGUS File Attribute (BASM) SWAG9408 2O~} 13 ┤φ {π EH> I am looking for a way to determine a filehandles' attributes, like isπ EH> possible in OS/2.ππ EH> The attributes I like to query (and maybe set), are the standard-fileπ EH> attribs. Still I cannot find a way to get to them except with theπ EH> filename, and a dos interrupt. What I am looking for is a dos interruptπ EH> that does exactly the same, but uses a filehandle instead of a filename.ππNo no no, file attributes can be returned/set only via DOS function 43h thatπassumes DS:DX point to a ASCIIZ file name. :(ππ { File attributes (combine these when setting) }ππ faNormal = $0000;π faReadOnly = $0001;π faHidden = $0002;π faSysFile = $0004;π faVolumeID = $0008;π faDirectory = $0010;π faArchive = $0020;π faAnyFile = $003F;ππFunction GetFileAttr(FileName : PChar) : integer; assembler;π{ Retrieves the attribute of a given file. The result is returned by DosError }πAsmπ MOV DosError,0π PUSH DSπ LDS DX,FileNameπ MOV AX,4300hπ INT 21hπ POP DSπ JNC @@noerrorπ MOV DosError,AX { save error code in DOS global variable }π@@noerror:π MOV AX,CXπEnd; { GetFileAttr }ππProcedure SetFileAttr(FileName : PChar; Attr : word); assembler;π{ Sets the new attribute to a given file. The result is returned by DosError }πAsmπ MOV DosError,0π PUSH DSπ LDS DX,FileNameπ MOV CX,Attrπ MOV AX,4301hπ INT 21hπ POP DSπ JC @@noerrorπ MOV DosError,AXπ@@noerror:πEnd; { SetFileAttr }π 9 08-24-9413:37ALL MARIUS ELLEN File There ?? SWAG9408 ⌐ué╙ 9 ┤φ π{ Try the DOS GetAttr function (Also faster than findfirst) }ππ { test to see if file exists }π function fIsFileP(SrcPath:pchar):boolean;π inline({get fattr, dos 2.0+}π $5A/ { pop dx }π $58/ { pop ax }π $1E/ { push ds }π $8E/$D8/ { mov ds,ax }π $B8/$00/$43/ { MOV AX,4300h }π $CD/$21/ { int 21h }π $1F/ { pop ds }π $72/$08/ { JC +8 }π $B8/$01/$00/ { MOV AX,1 }π $F6/$C1/$10/ { TEST CL,faDirectory }π $74/$02/ { JE +2 }π $31/$C0); { xor ax,ax }ππBEGINπ WriteLn(FisFIleP('\turbo\bp.exe'));πEND. 10 08-24-9413:48ALL HEGEL UDO Simple Multitasker SWAG9408 ╟«QF 62 ┤φ Unit Multi;π{--------------------------------------------------------------------------------}π{ }π{ Hilfsfunktionen zur quasi-Multitaskingverarbeitung unter Turbo Pascal }π{ }π{ (c) 1994 by Hegel Udo }π{ }π{--------------------------------------------------------------------------------}πInterfaceπ{--------------------------------------------------------------------------------}πTypeπ StartProc = Procedure;π{--------------------------------------------------------------------------------}πProcedure AddTask (Start : StartProc;StackSize : Word);πProcedure Transfer;π{--------------------------------------------------------------------------------}πImplementationπ{--------------------------------------------------------------------------------}πUsesπ Dos;π{--------------------------------------------------------------------------------}πTypeπ TaskPtr = ^TaskRec;π TaskRec = Recordπ StackSize : Word;π Stack : Pointer;π SPSave : Word;π SSSave : Word;π BPSave : Word;π Next : TaskPtr;π end;π{--------------------------------------------------------------------------------}πConstπ MinStack = 1024;π MaxStack = 32768;π{--------------------------------------------------------------------------------}πVarπ Tasks : TaskPtr;π AktTask : TaskPtr;π OldExit : Pointer;π{--------------------------------------------------------------------------------}πProcedure AddTask (Start : StartProc;StackSize : Word);πTypeπ OS = Recordπ O,S : Word;π end;πVarπ W : ^TaskPtr;π SS : Word;π SP : Word;πbeginπ W := @Tasks;π While Assigned (W^) do W := @W^^.Next;π New (W^);π if StackSize < MinStack then StackSize := MinStack;π if StackSize > MaxStack then StackSize := MaxStack;π W^^.StackSize := StackSize;π GetMem (W^^.Stack,StackSize);π SS := OS(W^^.Stack).S;π SP := OS(W^^.Stack).O+StackSize-4;π Move (Start,Ptr(SS,SP)^,4);π W^^.SPSave := SP;π W^^.SSSave := SS;π W^^.BPSave := W^^.SPSave;π W^^.Next := NIL;πend;π{--------------------------------------------------------------------------------}πProcedure Transfer; Assembler;πAsmπ LES SI,AktTask { Alter Status sichern }π MOV ES:[SI].TaskRec.SPSave,SPπ MOV ES:[SI].TaskRec.SSSave,SSπ MOV ES:[SI].TaskRec.BPSave,BPπ MOV AX,Word Ptr ES:[SI].TaskRec.Next { Neue Task bestimmen }π OR AX,Word Ptr ES:[SI].TaskRec.Next+2π JE @InitNewπ LES SI,ES:[SI].TaskRec.Nextπ JMP @DoJobπ@InitNew:π LES SI,Tasksπ@DoJob:π MOV Word Ptr AktTask,SI { Neue Task Sichern }π MOV Word Ptr AktTask+2,ESπ CLI { Status wieder hertstellen }π MOV SP,ES:[SI].TaskRec.SPSaveπ MOV SS,ES:[SI].TaskRec.SSSaveπ STIπ MOV BP,ES:[SI].TaskRec.BPSaveπend;π{--------------------------------------------------------------------------------}πBEGINπ New (Tasks); { Hauptprogramm als Task anmelden }π Tasks^.StackSize := 0;π Tasks^.Stack := NIL;π Tasks^.Next := NIL;π AktTask := Tasks;πEND.ππ{ -------------------------- DEMO PROGRAM ---------------------- }ππProgram Multi_Demo;ππUsesπ DOS, Crt, Multi;ππTYPEππ ScreenState = (free, used); { Is screen position free? }π WindowType = Record { Window descriptor }π X,π Y,π Xsize,π Ysize : Integer;π End;πππvar screen : Array(.0..81,0..26.) of ScreenState;π WindowTable : Array(.1..20.) of WindowType;π i,j, { Index variables }π NoWindows : Integer; { No. of windows on screen }ππProcedure MakeWindow(X, Y, Xsize, Ysize: Integer; Heading: String);ππ{ Reserves screenspace for window and draws border around it }ππ const NEcorner = #187; { Characters for double-line border }π SEcorner = #188;π SWcorner = #200;π NWcorner = #201;π Hor = #205;π Vert = #186;ππ var i,j : Integer;ππ Beginπ Window(1,1,80,25);ππ { Reserve screen space }π For i:=X to X+Xsize-1 Doπ For j:=Y to Y+Ysize-1 Do screen(.i,j.):=used;ππ { Draw border - sides }π i:=X;π For j:=Y+1 to Y+Ysize-2 Doπ Beginπ GotoXY(i,j);π Write(Vert);π End;ππ i:=X+Xsize-1;π For j:=Y+1 to Y+Ysize-2 Doπ Beginπ GotoXY(i,j);π Write(Vert);π End;ππ j:=Y;π For i:=X+1 to X+Xsize-2 Doπ Beginπ GotoXY(i,j);π Write(Hor);π End;ππ j:=Y+Ysize-1;π For i:=X+1 to X+Xsize-2 Doπ Beginπ GotoXY(i,j);π Write(Hor);π End;ππ { Draw border - corners }π GotoXY(X,Y);π Write(NWcorner);π GotoXY(X+Xsize-1,Y);π Write(NEcorner);π GotoXY(X+Xsize-1,Y+Ysize-1);π Write(SEcorner);π GotoXY(X,Y+Ysize-1);π Write(SWcorner);ππ { Make Heading }π GotoXY(X+(Xsize-Length(Heading)) div 2,Y);π Write(heading);ππ { Save in table }π NoWindows:=NoWindows+1;π WindowTable(.NoWindows.).X:=X;π WindowTable(.NoWindows.).Y:=Y;π WindowTable(.NoWindows.).Xsize:=Xsize;π WindowTable(.NoWindows.).Ysize:=Ysize;ππ End; { MakeWindow }ππProcedure SelectWindow(i : Integer);ππ { Specifies which window will receive subsequent output }ππ Beginπ With WindowTable(.i.) Doπ Beginπ Window(X+1,Y+1,X+Xsize-2,Y+Ysize-2);π End;π End; { SelectWindow }πππProcedure RemoveWindow(n: Integer);ππ { Removes window number n }ππ var i,j : Integer;ππ Beginπ SelectWindow(n);π With WindowTable(.n.) Doπ Beginπ Window(X,Y,X+Xsize,Y+Ysize);π For i:=X to X+Xsize Doπ For j:=Y to Y+Ysize Do screen(.i,j.):=free;π End; { With }π ClrScr;π End; { SelectWindow }ππProcedure Task1;Far;πVARπ SR : SearchRec;πbeginπ MakeWindow(27, 2,18,4,' Sub Task 1 ');π REPEATπ FINDFIRST('*.*',anyfile,SR);π WHILE DOSERROR = 0 DOπ BEGINπ Transfer;π SelectWindow(2);π WriteLn(SR.Name : 12);π FINDNEXT(SR);π Delay(10);π END;π UNTIL FALSE;πend;ππProcedure Task2;Far;πVARπ SR : SearchRec;πbeginπ MakeWindow(27, 7,18,4,' Sub Task 2 ');π REPEATπ FINDFIRST('\TURBO\TP\*.*',anyfile,SR);π WHILE DOSERROR = 0 DOπ BEGINπ Transfer;π SelectWindow(3);π WriteLn(SR.Name : 12);π FINDNEXT(SR);π Delay(10);π END;π UNTIL FALSE;πend;ππProcedure Task3;Far;πVARπ SR : SearchRec;πbeginπ MakeWindow(27,12,18,4,' Sub Task 3 ');π REPEATπ FINDFIRST('\TURBO\*.*',anyfile,SR);π WHILE DOSERROR = 0 DOπ BEGINπ Transfer;π SelectWindow(4);π WriteLn(SR.Name : 12);π FINDNEXT(SR);π Delay(10);π END;π UNTIL FALSE;πend;ππProcedure Task4;Far;πVARπ SR : SearchRec;πbeginπ MakeWindow(27,17,18,4,' Sub Task 4 ');π REPEATπ FINDFIRST('\*.*',anyfile,SR);π WHILE DOSERROR = 0 DOπ BEGINπ Transfer;π SelectWindow(5);π WriteLn(SR.Name : 12);π FINDNEXT(SR);π Delay(10);π END;π UNTIL FALSE;πend;ππBEGINπ ClrScr;π MakeWindow( 5,21,75,4,' Multi-Program Demo ');π SelectWindow(1);π WriteLn(' This is the MAIN task window and we will start 4 others too');π AddTask (Task1,8192);π AddTask (Task2,8192);π AddTask (Task3,8192);π AddTask (Task4,8192);π REPEATπ Transfer;π UNTIL KEYPRESSED;πEND.π 11 08-24-9413:55ALL GREG VIGNEAULT System Reboot SWAG9408 ╨º4â 17 ┤φ (*π System reset via software...ππ Using a jump to address $FFFF:0000 doesn't always work to rebootπ a system, particularly under multi-taskers. In a Windows 3.1 DOS-π session I get a dialog box, about a system violation, that tellsπ me to shut down all applications and restart the system -- but myπ PC is certainly not reset by the software reboot attempt.ππ AT-class systems ('286+) have a system controller IC which can beπ instructed to reset the system. This will force a reboot even underπ Windows. The following TP code illustrates this process.ππ Since this type of reset will interrupt all other processes, it'sπ important that an application first close all files and flush allπ buffers. It would also be a good idea to ask the user if a entireπ system reset is okay. Use this "power reset" prudently! ...π*)π(*******************************************************************)ππPROGRAM Reboot; { TP system reboot: Jul.19.94 Greg Vigneault }ππPROCEDURE SoftReset; { software reset for PC/XTs }π BEGIN { invalid for multi-taskers }π InLine( $2B/$C0/ { sub ax, ax }π $8E/$C0/ { mov es, ax }π $26/$C7/6/$72/4/$34/$12/ { mov es:[472h],1234h }π $EA/0/0/$FF/$FF); { jmp 0FFFFh:0000h }π END {SoftReset};ππPROCEDURE HardReset; { hardware reset for '286+ }π BEGIN { (uses system controller) }π InLine( $B0/$FE/ { mov al, 0FEh }π $E6/$64); { out 64h, al }π END {HardReset};πππBEGIN {Reboot}ππ WriteLn; WriteLn('POWER RESET courtesy Greg Vigneault...');π HardReset;π { if we're still running then the system is probably a PC/XT... }π SoftReset;ππEND {Reboot}.π{ Internet(Greg.Vigneault@westonia.com) Fido(1:250/636) }π(*******************************************************************)π 12 08-24-9413:55ALL JOHN HOWARD Redirection SWAG9408 ⌐«α╒ 34 ┤φ π{ I found an example of DOS redirection using TP. I think it came from eitherπ Dr. Dobb's or PC Magazine in 1992. I used this in my BinarY TExt (BYTE)π file tool which performs file splits, merges, encryption/decryption, scriptπ execution, and complete backwards and forwards byte resolution manipulation.π}πUNIT Echo;ππINTERFACEππUSES DOS;ππ FUNCTION InputRedirected : Boolean;π FUNCTION OutputRedirected : Boolean;π FUNCTION OutputNul : Boolean;π FUNCTION EchoIsOn : Boolean;π PROCEDURE EchoOn;π PROCEDURE EchoOff;ππIMPLEMENTATIONππ FUNCTION InputRedirected : Boolean;π VAR Regs : Registers; Handle : Word ABSOLUTE Input;π BEGINπ WITH Regs DOπ BEGINπ Ax := $4400;π Bx := Handle;π MsDos(Regs);π IF Dl AND $81 = $81 THEN InputRedirected := Falseπ ELSE InputRedirected := True;π END; {With Regs}π END; {Function InputRedirected}πππ FUNCTION OutputRedirected : Boolean;π VAR Regs : Registers; Handle : Word ABSOLUTE Output;π BEGINπ WITH Regs DOπ BEGINπ Ax := $4400;π Bx := Handle;π MsDos(Regs);π IF Dl AND $82 = $82 THEN OutputRedirected := Falseπ ELSE OutputRedirected := True;π END; {With Regs}π END; {Function OutputRedirected}πππ FUNCTION OutputNul : Boolean;π VAR Regs : Registers; Handle : Word ABSOLUTE Output;π BEGINπ WITH Regs DOπ BEGINπ Ax := $4400;π Bx := Handle;π MsDos(Regs);π IF Dl AND $84 <> $84 THEN OutputNul := Falseπ ELSE OutputNul := True;π END; {With Regs}π END; {Function OutputNul}πππ FUNCTION Write40h(DataBuffer : Pointer; Count, Handle : Word) : Word;π VAR Regs : Registers;π TYPE DWord = RECORD O, S : Word; END;π BEGINπ WITH Regs DOπ BEGINπ Ds := DWord(DataBuffer).S;π Dx := DWord(DataBuffer).O;π Bx := Handle;π Cx := Count;π Ah := $40;π MsDos(Regs);π IF Flags AND FCarry <> 0π THEN Write40h := 103 {- "file not open" -}π ELSE IF Ax < Cxπ THEN Write40h := 101 {- "disk write error" -}π ELSE Write40h := 0;π END; {With Regs do}π END; {Function Write40h}πππ{$F+} FUNCTION EchoOutput(VAR F : TextRec) : Integer; {$F-}π{- Replacement for Output text file FlushFunc and InOutFunc -}π BEGINπ WITH F DOπ BEGINπ EchoOutput := Write40h(BufPtr, BufPos, 2);π EchoOutput := Write40h(BufPtr, BufPos, Handle);π BufPos := 0;π END; {With F do}π END; {Function EchoOutput}πππCONST EchoStatus : Boolean = False; {- PRIVATE to unit Echo -}ππ PROCEDURE EchoOn;π BEGINπ IF OutputRedirected THENπ BEGINπ Flush(Output);π TextRec(Output).InOutFunc := @EchoOutput;π TextRec(Output).FlushFunc := @EchoOutput;π EchoStatus := True;π END; {If OutputRedirected}π END; {Procedure EchoOn}ππ PROCEDURE EchoOff;π BEGINπ IF OutputRedirected THENπ BEGINπ Rewrite(Output);π EchoStatus := False;π END; {If OutputRedirected THEN}π END; {Procedure EchoOff}ππ FUNCTION EchoIsOn : Boolean;π BEGINπ EchoIsOn := EchoStatus;π END; {Function EchoIsOn}πππBEGIN {- Unit initialization -}π EchoOn; {- Echo all redirected output -}πEND.ππ{-------------------------------------------------------------------}πPROGRAM EchoDemo;πUSES Echo;πBEGINπ IF InputRedirected THEN WriteLn('Input is being redirected');π IF OutputNul THENπ BEGINπ WriteLn('Output is being sent to the Nul device');π EchoOff;π END;π IF OutputRedirected THEN WriteLn('Output is being redirected');ππ WriteLn('--------1--------');π EchoOff;π WriteLn('--------2--------');π IF NOT OutputNul THEN EchoOn;π WriteLn('--------3--------');π EchoOff;π WriteLn('--------4--------');πEND.π 13 08-24-9413:56ALL VARIOUS Detecting Share (BASM) SWAG9408 L∩╖L 17 ┤φ { Can one one post some code to check this please.}ππ{--------------------------------------------------------- Share loaded ? ---}π{ BAS VAN GAALEN }πfunction share_loaded : boolean; assembler; asmπ mov ax,01000h; int 02fh; xor ah,ah; and al,0ffh; end;ππ{----------------------------------------------------------------------------}π{ ANDREW EIGUSπINT 2F - SHARE - INSTALLATION CHECKπ AX = 1000hπReturn: AL = 00h not installed, OK to installπ 01h not installed, not OK to installπ ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ππfunction will return True here and it should not. So this one will work:π}ππFunction ShareDetected : boolean; assembler;πAsmπ MOV AX,1000hπ INT 2Fhπ CMP AL,0FFhπ JE @@1π MOV AL,Falseπ JMP @@2π@@1:π MOV AL,Trueπ@@2:πEnd; { ShareDetected }ππ{----------------------------------------------------------------------------}π{IAN LIN}ππconstπ noshareinstall=0;π nosharenoinstall=1;π shareinstalled=$ff;ππfunction shareloaded:byte;πassembler; asmπ mov ax,$1000π int $2fπend;ππINT 2F - SHARE - INSTALLATION CHECKπ AX = 1000hπReturn: AL = 00h not installed, OK to installπ 01h not installed, not OK to installπ FFh installedπBUGS: values of AL other than 00h put DOS 3.x SHARE into an infinite loopπ (08E9: OR AL,ALπ 08EB: JNZ 08EB) <- the buggy instruction (DOS 3.3)π values of AL other than described here put PC-DOS 4.00 into the sameπ loop (the buggy instructions are the same)πNotes: supported by OS/2 v1.3+ compatibility box, which always returns AL=FFhπ if DOS 4.01 SHARE was automatically loaded, file sharing is in anπ inactive state (due to the undocumented /NC flag used by the autoloadπ code) until this call is madeπ DOS 5+ chains to the previous handler if AL <> 00h on entryπ Windows Enhanced mode hooks this call and reports that SHARE isπ installed even when it is notπSeeAlso: AX=1080h,INT 21/AH=52hππ 14 08-24-9417:52ALL PETE ROCCA Time Slices SWAG9408 ⌠àφ 15 ┤φ {πDoes anyone got any unit/code on giving up time slice under DV or OS/2?πHere they are for DOS, Windows, OS/2, DV and DoubleDos. You will needπto detect the enviroment first (although none should make the systemπhang if it's the wrong enviroment, just be ignored) The key to goodπidle release is finding the right spots to put them. I have gotten myπdoor making unit that I created to about 97% idle during pauses and 93%πidle while waiting for keyboard input (with no delay in response - muchπbetter than the typical 12% idle pauses and 8% idle keyboard waits)πHere is how...π}ππProcedure Sleep(Seconds: Word);πVarπ H,M,S,T,Last: Word;πBeginπ If Seconds = 0 Then Exit;π If Seconds > 999 Then Seconds := Seconds DIV 1000;π {incase of caller is thinking milliseconds}ππ GetTime(H,M,Last,T);π Repeatπ Repeatπ GetTime(H,M,S,T);π TimerSlice;π TimerSlice;π Until S <> Last;π Last := S;π Dec(Seconds);π Until Seconds = 0;πEnd;ππFunction GetChar: Char;πVarπ Counter, Span: Byte;π Done: Boolean;πBeginπ Span := 0;π Done := False;π Repeatπ Inc(Counter);π If Counter > Span Thenπ Beginπ Counter := 0;π If IsChar Then Done := Trueπ Else If Span < 50 Then Inc(Span);π Endπ Else TimerSlice;π Until Done;π If KeyPressedExtended Then GetChar := Readkeyπ Else GetChar := RxChar;πEnd;ππProcedure TimerSlice;πBeginπ Case SystemEnviroment Ofπ DOS4:;π DOS5,π WINDOWS,π OS2: Asmπ MOV AX,$1680π INT $2Fπ End;π DV: Asmπ MOV AX,$1000π INT $15π End;π DOUBLEDOS: Asmπ MOV AX,$EE01π INT $21π End;π End;πEnd;π 15 08-24-9417:52ALL BJÖRN FELTEN TRUENAME (BASM) SWAG9408 w╟┌ì 10 ┤φ ππprogram TName; { to test the TrueName function }ππfunction TrueName(var P: string): string; assembler;π{ returns TrueName just like the DOS command does }π{ if error, returns a zero length string }π{ will probably crash for DOS versions < 3.0 }π{ donated to the Public Domain by Björn Felten @ 2:203/208 }πasmπ push dsπ lds si,Pπ@strip:π inc si { skip length byte ... }π cmp byte ptr [si],' 'π jle @strip { ... and trailing white space }ππ les di,@Resultπ inc di { leave room for byte count }π mov ah,60h { undocumented DOS call }π int 21hπ pop dsπ jc @errorππ mov cx,80 { convert ASCIZ to Pascal string }π xor ax,axπ repnz scasb { find trailing zero }π mov ax,80π sub ax,cx { get length byte }π jmp @retππ@error:π xor ax,ax { return zero length string }ππ@ret:π les di,@Resultπ stosbπend;πππvar S:string;πbeginπ S:=paramstr(1);π if paramcount<>1 thenπ writeln('Usage: tname <filename>')π elseπ writeln('TrueName of ',S,' is ',TrueName(S))πend.π 16 08-24-9417:54ALL FRANK DIACHEYSN WAIT Procedure SWAG9408 ÷ö╬ 8 ┤φ {π Coded By Frank Diacheysn Of Gemini Softwareππ PROCEDURE WAITππ Input......: Secs = Long Integer Value For The Number Of SECONDSπ : (NOT Milliseconds) To Delayπ :π :π :ππ Output.....: Noneπ :π :π :π :ππ Example....: Wait(5); (Wait 5 Seconds)π :π :π :π :ππ Description: Works Exactly Like The CRT Unit's Delay Procedure, Exceptπ : This Procedure Works With Seconds, Not Millisecondsπ :π :π :ππ}πPROCEDURE Wait( Secs:LONGINT );πVAR MS : WORD;πBEGINπ Secs := Secs * 1000;π ASMπ MOV AX, 1000;π MUL Secs;π MOV CX, DX;π MOV DX, AX;π MOV AH, $86;π INT $15;π END;πEND;π 17 08-24-9417:54ALL FRANK DIACHEYSN Where is DOS SWAG9408 ÄY&] 11 ┤φ {π Coded By Frank Diacheysn Of Gemini Softwareππ FUNCTION WHEREISDOSππ Input......: Noneπ :π :π :π :πππ Output.....: 2-Character String, Explained Further Below.π :π :π :π :ππ Example....: IF Chars[1] = 'O' THENπ : WriteLn('DOS Is Resident In ROM')π : ELSEπ : WriteLn('DOS Is Resident In RAM');π : IF Chars[2] = 'H' THENπ : WriteLn('DOS Is Loaded Into High Memory (HMA)')π : ELSEπ : WriteLn('DOS Is Loaded Into Conventional Memory');ππ Description: Returns The Status Of Where DOS Is Loaded Using The Following:π : Chars[1] = 'O' (Resident In ROM)π : Chars[1] = 'A' (Resident In RAM)π : Chars[2] = 'H' (Loaded In High Memory)π : Chars[2] = 'C' (Loaded in Conventional Memory)ππ}πFUNCTION WHEREISDOS:STRING;πVAR Chars : ARRAY [1..2] OF CHAR;πBEGINπ Regs.AH := $33;π Regs.AL := $06;π Intr( $33,Regs );π IF (Regs.DH AND $04)=$04 THEN Chars[1] := 'O' ELSE Chars[1] := 'A';π IF (Regs.DH AND $08)=$08 THEN Chars[2] := 'H' ELSE Chars[2] := 'C';π WHEREISDOS := Chars[1]+Chars[2];πEND;π 18 08-24-9417:57ALL RICK SCHAEFER Yes/No in Batch files SWAG9408 .;°≡ 9 ┤φ π{πThis is a VERY simple program to return anπerrorlevel based on whether the user pressed Y or N at a Yes/Noπprompt. Has to be simple since the wife uses it. :-) I use it in myπbatch files to branch to a different option depending on the user'sπselection.πππ{ Yes/No Errorlevel returner v.000003432ß }π{ Returns errorlevel depending on the key }π{ chosen by the end user. }π{ by Rick Schaefer }π{ Donated to the public domain }ππProgram YNExe;π Uses Dos,π Crt;πvarπ YN : char;π i : integer;ππ PROCEDURE Color(back, fore : BYTE);π BEGINπ TextAttr := (Fore + (Back SHL 4) ) MOD 128;π END;ππbeginπ color(15,0);π writeln;π writeln;π for i := 1 to paramcount do write(paramstr(i)+' ');π write(' (Y/N)? ');π YN := readkey;π YN := upcase(YN);π textcolor(14);π writeln(yn);π if (YN = 'Y') then halt(1);π if (YN = 'N') then halt(0);πend.π 19 08-25-9409:07ALL RANDALL WOODMAN Error Messages SWAG9408 º▓┘┼ 35 ┤φ Unit ExtError;π π{ Information lifted from 'Disk Operating System 3.30 Technical Reference'.π An IBM publication. USE this unit with DOS 3.0 or higher. π}π πInterfaceπ πImplementationπuses Dos;π π{$F+,R-,S-,I- }π πVarπ ExitSave : Pointer;π πProcedure GetExtendedError;π πVarπ Regs : Registers;π s : String;π πBeginπ ExitProc := ExitSave;π Regs.AH := $59;π Regs.BX := $0000;π Intr($21, Regs);π Write('Error #');π Case Regs.AX ofπ 1 : s := 'Invalid function number';π 2 : s := 'File not found';π 3 : s := 'Path not found';π 4 : s := 'Too many open files (no handles left)';π 5 : s := 'Access denied (file was opened Read Only)';π 6 : s := 'Invalid handle';π 7 : s := 'Memory control blocks destroyed';π 8 : s := 'Insufficient memory';π 9 : s := 'Invalid memory block address';π 10 : s := 'Invalid environment';π 11 : s := 'Invalid format';π 12 : s := 'Invalid access code';π 13 : s := 'Invalid data';π 15 : s := 'Invalid drive was specified';π 16 : s := 'Attempt to remove current directory';π 17 : s := 'Not same device';π 18 : s := 'No more files';π 19 : s := 'Attempt to write on write-protected diskette';π 20 : s := 'Unknown unit';π 21 : s := 'Drive not ready';π 22 : s := 'Unknown command';π 23 : s := 'Data error (CRC)';π 24 : s := 'Bad request structure length';π 25 : s := 'Seek error';π 26 : s := 'Unknown media type';π 27 : s := 'Sector not found';π 28 : s := 'Printer out of paper';π 29 : s := 'Write fault';π 30 : s := 'Read fault';π 31 : s := 'General failure';π 32 : s := 'Sharing violation';π 33 : s := 'Lock violation';π 34 : s := 'Invalid disk change';π 35 : s := 'FCB unavailable';π 36 : s := 'Sharing buffer overflow';π 50 : s := 'Network request not supported';π 51 : s := 'Remote computer not listening';π 52 : s := 'Duplicate name on network';π 53 : s := 'Network name not found';π 54 : s := 'Network busy';π 55 : s := 'Network device no longer exists';π 56 : s := 'Net BIOS command limit exceeded';π 57 : s := 'Network adapter hardware error';π 58 : s := 'Incorrect response from network';π 59 : s := 'Unexpected network error';π 60 : s := 'Incompatible remote adapter';π 61 : s := 'Print queue full';π 62 : s := 'Not enough space for print file';π 63 : s := 'Print file was deleted';π 65 : s := 'Access denied';π 66 : s := 'Network device type incorrect';π 67 : s := 'Network name not found';π 68 : s := 'Network name limit exceeded';π 69 : s := 'Net BIOS session limit exceeded';π 70 : s := 'Temporarily paused';π 71 : s := 'Network request not accepted';π 72 : s := 'Print or disk redirection is paused';π 80 : s := 'File exists';π 82 : s := 'Cannot make directory entry';π 83 : s := 'Fail on INT 24';π 84 : s := 'Too many redirections';π 85 : s := 'Duplicate redirection';π 86 : s := 'Invalid password';π 87 : s := 'Invalid parameter';π 88 : s := 'Network device fault';π end;π WriteLn(Regs.AX, ': ', s);π Write('Error class: ');π Case Regs.BH ofπ 1 : s := 'Out of resource';π 2 : s := 'Temporary situation';π 3 : s := 'Permission problem';π 4 : s := 'Internal error in system software';π 5 : s := 'Hardware failure';π 6 : s := 'Serious failure of system software';π 7 : s := 'Application program error';π 8 : s := 'File/item not found';π 9 : s := 'File/item of invalid format or type';π 10 : s := 'File/item interlocked';π 11 : s := 'Media failure: wrong disk, CRC error...';π 12 : s := 'Collision with existing item';π 13 : s := 'Classification doesn''t exist or is inappropriate';π end;π WriteLn(s);π Write('Suggested action: ');π Case Regs.BL ofπ 1 : s := 'Retry';π 2 : s := 'Retry after pause';π 3 : s := 'Ask user to re-enter input';π 4 : s := 'Abort program with cleanup';π 5 : s := 'Abort immediately, skip cleanup';π 6 : s := 'Ignore';π 7 : s := 'Retry after user intervention';π end;π WriteLn(s);π Write('Error locus: ');π Case Regs.CH ofπ 1 : s := 'Unknown or inappropriate';π 2 : s := 'Related to disk storage';π 3 : s := 'Related to the network';π 4 : s := 'Serial device';π 5 : s := 'Memory';π end;π WriteLn(s);π Halt;πend; { GetExtendedError }ππBeginπ ExitSave := ExitProc;π ExitProc := @GetExtendedError;πend. { ExtError }π
